{-# 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.UpdateDistribution
-- 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 the configuration for a CloudFront distribution.
--
-- The update process includes getting the current distribution
-- configuration, updating it to make your changes, and then submitting an
-- @UpdateDistribution@ request to make the updates.
--
-- __To update a web distribution using the CloudFront API__
--
-- 1.  Use @GetDistributionConfig@ to get the current configuration,
--     including the version identifier (@ETag@).
--
-- 2.  Update the distribution configuration that was returned in the
--     response. Note the following important requirements and
--     restrictions:
--
--     -   You must rename the @ETag@ field to @IfMatch@, leaving the value
--         unchanged. (Set the value of @IfMatch@ to the value of @ETag@,
--         then remove the @ETag@ field.)
--
--     -   You can\'t change the value of @CallerReference@.
--
-- 3.  Submit an @UpdateDistribution@ request, providing the distribution
--     configuration. The new configuration replaces the existing
--     configuration. The values that you specify in an
--     @UpdateDistribution@ request are not merged into your existing
--     configuration. Make sure to include all fields: the ones that you
--     modified and also the ones that you didn\'t.
module Amazonka.CloudFront.UpdateDistribution
  ( -- * Creating a Request
    UpdateDistribution (..),
    newUpdateDistribution,

    -- * Request Lenses
    updateDistribution_ifMatch,
    updateDistribution_distributionConfig,
    updateDistribution_id,

    -- * Destructuring the Response
    UpdateDistributionResponse (..),
    newUpdateDistributionResponse,

    -- * Response Lenses
    updateDistributionResponse_distribution,
    updateDistributionResponse_eTag,
    updateDistributionResponse_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

-- | The request to update a distribution.
--
-- /See:/ 'newUpdateDistribution' smart constructor.
data UpdateDistribution = UpdateDistribution'
  { -- | The value of the @ETag@ header that you received when retrieving the
    -- distribution\'s configuration. For example: @E2QWRUHAPOMQZL@.
    UpdateDistribution -> Maybe Text
ifMatch :: Prelude.Maybe Prelude.Text,
    -- | The distribution\'s configuration information.
    UpdateDistribution -> DistributionConfig
distributionConfig :: DistributionConfig,
    -- | The distribution\'s id.
    UpdateDistribution -> Text
id :: Prelude.Text
  }
  deriving (UpdateDistribution -> UpdateDistribution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDistribution -> UpdateDistribution -> Bool
$c/= :: UpdateDistribution -> UpdateDistribution -> Bool
== :: UpdateDistribution -> UpdateDistribution -> Bool
$c== :: UpdateDistribution -> UpdateDistribution -> Bool
Prelude.Eq, Int -> UpdateDistribution -> ShowS
[UpdateDistribution] -> ShowS
UpdateDistribution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDistribution] -> ShowS
$cshowList :: [UpdateDistribution] -> ShowS
show :: UpdateDistribution -> String
$cshow :: UpdateDistribution -> String
showsPrec :: Int -> UpdateDistribution -> ShowS
$cshowsPrec :: Int -> UpdateDistribution -> ShowS
Prelude.Show, forall x. Rep UpdateDistribution x -> UpdateDistribution
forall x. UpdateDistribution -> Rep UpdateDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDistribution x -> UpdateDistribution
$cfrom :: forall x. UpdateDistribution -> Rep UpdateDistribution x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDistribution' 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', 'updateDistribution_ifMatch' - The value of the @ETag@ header that you received when retrieving the
-- distribution\'s configuration. For example: @E2QWRUHAPOMQZL@.
--
-- 'distributionConfig', 'updateDistribution_distributionConfig' - The distribution\'s configuration information.
--
-- 'id', 'updateDistribution_id' - The distribution\'s id.
newUpdateDistribution ::
  -- | 'distributionConfig'
  DistributionConfig ->
  -- | 'id'
  Prelude.Text ->
  UpdateDistribution
newUpdateDistribution :: DistributionConfig -> Text -> UpdateDistribution
newUpdateDistribution DistributionConfig
pDistributionConfig_ Text
pId_ =
  UpdateDistribution'
    { $sel:ifMatch:UpdateDistribution' :: Maybe Text
ifMatch = forall a. Maybe a
Prelude.Nothing,
      $sel:distributionConfig:UpdateDistribution' :: DistributionConfig
distributionConfig = DistributionConfig
pDistributionConfig_,
      $sel:id:UpdateDistribution' :: Text
id = Text
pId_
    }

-- | The value of the @ETag@ header that you received when retrieving the
-- distribution\'s configuration. For example: @E2QWRUHAPOMQZL@.
updateDistribution_ifMatch :: Lens.Lens' UpdateDistribution (Prelude.Maybe Prelude.Text)
updateDistribution_ifMatch :: Lens' UpdateDistribution (Maybe Text)
updateDistribution_ifMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe Text
ifMatch :: Maybe Text
$sel:ifMatch:UpdateDistribution' :: UpdateDistribution -> Maybe Text
ifMatch} -> Maybe Text
ifMatch) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe Text
a -> UpdateDistribution
s {$sel:ifMatch:UpdateDistribution' :: Maybe Text
ifMatch = Maybe Text
a} :: UpdateDistribution)

-- | The distribution\'s configuration information.
updateDistribution_distributionConfig :: Lens.Lens' UpdateDistribution DistributionConfig
updateDistribution_distributionConfig :: Lens' UpdateDistribution DistributionConfig
updateDistribution_distributionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {DistributionConfig
distributionConfig :: DistributionConfig
$sel:distributionConfig:UpdateDistribution' :: UpdateDistribution -> DistributionConfig
distributionConfig} -> DistributionConfig
distributionConfig) (\s :: UpdateDistribution
s@UpdateDistribution' {} DistributionConfig
a -> UpdateDistribution
s {$sel:distributionConfig:UpdateDistribution' :: DistributionConfig
distributionConfig = DistributionConfig
a} :: UpdateDistribution)

-- | The distribution\'s id.
updateDistribution_id :: Lens.Lens' UpdateDistribution Prelude.Text
updateDistribution_id :: Lens' UpdateDistribution Text
updateDistribution_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Text
id :: Text
$sel:id:UpdateDistribution' :: UpdateDistribution -> Text
id} -> Text
id) (\s :: UpdateDistribution
s@UpdateDistribution' {} Text
a -> UpdateDistribution
s {$sel:id:UpdateDistribution' :: Text
id = Text
a} :: UpdateDistribution)

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

instance Prelude.Hashable UpdateDistribution where
  hashWithSalt :: Int -> UpdateDistribution -> Int
hashWithSalt Int
_salt UpdateDistribution' {Maybe Text
Text
DistributionConfig
id :: Text
distributionConfig :: DistributionConfig
ifMatch :: Maybe Text
$sel:id:UpdateDistribution' :: UpdateDistribution -> Text
$sel:distributionConfig:UpdateDistribution' :: UpdateDistribution -> DistributionConfig
$sel:ifMatch:UpdateDistribution' :: UpdateDistribution -> 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` DistributionConfig
distributionConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateDistribution where
  rnf :: UpdateDistribution -> ()
rnf UpdateDistribution' {Maybe Text
Text
DistributionConfig
id :: Text
distributionConfig :: DistributionConfig
ifMatch :: Maybe Text
$sel:id:UpdateDistribution' :: UpdateDistribution -> Text
$sel:distributionConfig:UpdateDistribution' :: UpdateDistribution -> DistributionConfig
$sel:ifMatch:UpdateDistribution' :: UpdateDistribution -> 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 DistributionConfig
distributionConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

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

instance Data.ToHeaders UpdateDistribution where
  toHeaders :: UpdateDistribution -> ResponseHeaders
toHeaders UpdateDistribution' {Maybe Text
Text
DistributionConfig
id :: Text
distributionConfig :: DistributionConfig
ifMatch :: Maybe Text
$sel:id:UpdateDistribution' :: UpdateDistribution -> Text
$sel:distributionConfig:UpdateDistribution' :: UpdateDistribution -> DistributionConfig
$sel:ifMatch:UpdateDistribution' :: UpdateDistribution -> 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 UpdateDistribution where
  toPath :: UpdateDistribution -> ByteString
toPath UpdateDistribution' {Maybe Text
Text
DistributionConfig
id :: Text
distributionConfig :: DistributionConfig
ifMatch :: Maybe Text
$sel:id:UpdateDistribution' :: UpdateDistribution -> Text
$sel:distributionConfig:UpdateDistribution' :: UpdateDistribution -> DistributionConfig
$sel:ifMatch:UpdateDistribution' :: UpdateDistribution -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-05-31/distribution/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id,
        ByteString
"/config"
      ]

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

-- | The returned result of the corresponding request.
--
-- /See:/ 'newUpdateDistributionResponse' smart constructor.
data UpdateDistributionResponse = UpdateDistributionResponse'
  { -- | The distribution\'s information.
    UpdateDistributionResponse -> Maybe Distribution
distribution :: Prelude.Maybe Distribution,
    -- | The current version of the configuration. For example: @E2QWRUHAPOMQZL@.
    UpdateDistributionResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateDistributionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDistributionResponse -> UpdateDistributionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDistributionResponse -> UpdateDistributionResponse -> Bool
$c/= :: UpdateDistributionResponse -> UpdateDistributionResponse -> Bool
== :: UpdateDistributionResponse -> UpdateDistributionResponse -> Bool
$c== :: UpdateDistributionResponse -> UpdateDistributionResponse -> Bool
Prelude.Eq, Int -> UpdateDistributionResponse -> ShowS
[UpdateDistributionResponse] -> ShowS
UpdateDistributionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDistributionResponse] -> ShowS
$cshowList :: [UpdateDistributionResponse] -> ShowS
show :: UpdateDistributionResponse -> String
$cshow :: UpdateDistributionResponse -> String
showsPrec :: Int -> UpdateDistributionResponse -> ShowS
$cshowsPrec :: Int -> UpdateDistributionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDistributionResponse x -> UpdateDistributionResponse
forall x.
UpdateDistributionResponse -> Rep UpdateDistributionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDistributionResponse x -> UpdateDistributionResponse
$cfrom :: forall x.
UpdateDistributionResponse -> Rep UpdateDistributionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDistributionResponse' 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:
--
-- 'distribution', 'updateDistributionResponse_distribution' - The distribution\'s information.
--
-- 'eTag', 'updateDistributionResponse_eTag' - The current version of the configuration. For example: @E2QWRUHAPOMQZL@.
--
-- 'httpStatus', 'updateDistributionResponse_httpStatus' - The response's http status code.
newUpdateDistributionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDistributionResponse
newUpdateDistributionResponse :: Int -> UpdateDistributionResponse
newUpdateDistributionResponse Int
pHttpStatus_ =
  UpdateDistributionResponse'
    { $sel:distribution:UpdateDistributionResponse' :: Maybe Distribution
distribution =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:UpdateDistributionResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDistributionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The distribution\'s information.
updateDistributionResponse_distribution :: Lens.Lens' UpdateDistributionResponse (Prelude.Maybe Distribution)
updateDistributionResponse_distribution :: Lens' UpdateDistributionResponse (Maybe Distribution)
updateDistributionResponse_distribution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionResponse' {Maybe Distribution
distribution :: Maybe Distribution
$sel:distribution:UpdateDistributionResponse' :: UpdateDistributionResponse -> Maybe Distribution
distribution} -> Maybe Distribution
distribution) (\s :: UpdateDistributionResponse
s@UpdateDistributionResponse' {} Maybe Distribution
a -> UpdateDistributionResponse
s {$sel:distribution:UpdateDistributionResponse' :: Maybe Distribution
distribution = Maybe Distribution
a} :: UpdateDistributionResponse)

-- | The current version of the configuration. For example: @E2QWRUHAPOMQZL@.
updateDistributionResponse_eTag :: Lens.Lens' UpdateDistributionResponse (Prelude.Maybe Prelude.Text)
updateDistributionResponse_eTag :: Lens' UpdateDistributionResponse (Maybe Text)
updateDistributionResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:UpdateDistributionResponse' :: UpdateDistributionResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: UpdateDistributionResponse
s@UpdateDistributionResponse' {} Maybe Text
a -> UpdateDistributionResponse
s {$sel:eTag:UpdateDistributionResponse' :: Maybe Text
eTag = Maybe Text
a} :: UpdateDistributionResponse)

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

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