{-# 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.Lightsail.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 an existing Amazon Lightsail content delivery network (CDN)
-- distribution.
--
-- Use this action to update the configuration of your existing
-- distribution.
module Amazonka.Lightsail.UpdateDistribution
  ( -- * Creating a Request
    UpdateDistribution (..),
    newUpdateDistribution,

    -- * Request Lenses
    updateDistribution_cacheBehaviorSettings,
    updateDistribution_cacheBehaviors,
    updateDistribution_defaultCacheBehavior,
    updateDistribution_isEnabled,
    updateDistribution_origin,
    updateDistribution_distributionName,

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

    -- * Response Lenses
    updateDistributionResponse_operation,
    updateDistributionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDistribution' smart constructor.
data UpdateDistribution = UpdateDistribution'
  { -- | An object that describes the cache behavior settings for the
    -- distribution.
    --
    -- The @cacheBehaviorSettings@ specified in your
    -- @UpdateDistributionRequest@ will replace your distribution\'s existing
    -- settings.
    UpdateDistribution -> Maybe CacheSettings
cacheBehaviorSettings :: Prelude.Maybe CacheSettings,
    -- | An array of objects that describe the per-path cache behavior for the
    -- distribution.
    UpdateDistribution -> Maybe [CacheBehaviorPerPath]
cacheBehaviors :: Prelude.Maybe [CacheBehaviorPerPath],
    -- | An object that describes the default cache behavior for the
    -- distribution.
    UpdateDistribution -> Maybe CacheBehavior
defaultCacheBehavior :: Prelude.Maybe CacheBehavior,
    -- | Indicates whether to enable the distribution.
    UpdateDistribution -> Maybe Bool
isEnabled :: Prelude.Maybe Prelude.Bool,
    -- | An object that describes the origin resource for the distribution, such
    -- as a Lightsail instance, bucket, or load balancer.
    --
    -- The distribution pulls, caches, and serves content from the origin.
    UpdateDistribution -> Maybe InputOrigin
origin :: Prelude.Maybe InputOrigin,
    -- | The name of the distribution to update.
    --
    -- Use the @GetDistributions@ action to get a list of distribution names
    -- that you can specify.
    UpdateDistribution -> Text
distributionName :: 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, ReadPrec [UpdateDistribution]
ReadPrec UpdateDistribution
Int -> ReadS UpdateDistribution
ReadS [UpdateDistribution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDistribution]
$creadListPrec :: ReadPrec [UpdateDistribution]
readPrec :: ReadPrec UpdateDistribution
$creadPrec :: ReadPrec UpdateDistribution
readList :: ReadS [UpdateDistribution]
$creadList :: ReadS [UpdateDistribution]
readsPrec :: Int -> ReadS UpdateDistribution
$creadsPrec :: Int -> ReadS UpdateDistribution
Prelude.Read, 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:
--
-- 'cacheBehaviorSettings', 'updateDistribution_cacheBehaviorSettings' - An object that describes the cache behavior settings for the
-- distribution.
--
-- The @cacheBehaviorSettings@ specified in your
-- @UpdateDistributionRequest@ will replace your distribution\'s existing
-- settings.
--
-- 'cacheBehaviors', 'updateDistribution_cacheBehaviors' - An array of objects that describe the per-path cache behavior for the
-- distribution.
--
-- 'defaultCacheBehavior', 'updateDistribution_defaultCacheBehavior' - An object that describes the default cache behavior for the
-- distribution.
--
-- 'isEnabled', 'updateDistribution_isEnabled' - Indicates whether to enable the distribution.
--
-- 'origin', 'updateDistribution_origin' - An object that describes the origin resource for the distribution, such
-- as a Lightsail instance, bucket, or load balancer.
--
-- The distribution pulls, caches, and serves content from the origin.
--
-- 'distributionName', 'updateDistribution_distributionName' - The name of the distribution to update.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
newUpdateDistribution ::
  -- | 'distributionName'
  Prelude.Text ->
  UpdateDistribution
newUpdateDistribution :: Text -> UpdateDistribution
newUpdateDistribution Text
pDistributionName_ =
  UpdateDistribution'
    { $sel:cacheBehaviorSettings:UpdateDistribution' :: Maybe CacheSettings
cacheBehaviorSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cacheBehaviors:UpdateDistribution' :: Maybe [CacheBehaviorPerPath]
cacheBehaviors = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultCacheBehavior:UpdateDistribution' :: Maybe CacheBehavior
defaultCacheBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:isEnabled:UpdateDistribution' :: Maybe Bool
isEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:origin:UpdateDistribution' :: Maybe InputOrigin
origin = forall a. Maybe a
Prelude.Nothing,
      $sel:distributionName:UpdateDistribution' :: Text
distributionName = Text
pDistributionName_
    }

-- | An object that describes the cache behavior settings for the
-- distribution.
--
-- The @cacheBehaviorSettings@ specified in your
-- @UpdateDistributionRequest@ will replace your distribution\'s existing
-- settings.
updateDistribution_cacheBehaviorSettings :: Lens.Lens' UpdateDistribution (Prelude.Maybe CacheSettings)
updateDistribution_cacheBehaviorSettings :: Lens' UpdateDistribution (Maybe CacheSettings)
updateDistribution_cacheBehaviorSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe CacheSettings
cacheBehaviorSettings :: Maybe CacheSettings
$sel:cacheBehaviorSettings:UpdateDistribution' :: UpdateDistribution -> Maybe CacheSettings
cacheBehaviorSettings} -> Maybe CacheSettings
cacheBehaviorSettings) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe CacheSettings
a -> UpdateDistribution
s {$sel:cacheBehaviorSettings:UpdateDistribution' :: Maybe CacheSettings
cacheBehaviorSettings = Maybe CacheSettings
a} :: UpdateDistribution)

-- | An array of objects that describe the per-path cache behavior for the
-- distribution.
updateDistribution_cacheBehaviors :: Lens.Lens' UpdateDistribution (Prelude.Maybe [CacheBehaviorPerPath])
updateDistribution_cacheBehaviors :: Lens' UpdateDistribution (Maybe [CacheBehaviorPerPath])
updateDistribution_cacheBehaviors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe [CacheBehaviorPerPath]
cacheBehaviors :: Maybe [CacheBehaviorPerPath]
$sel:cacheBehaviors:UpdateDistribution' :: UpdateDistribution -> Maybe [CacheBehaviorPerPath]
cacheBehaviors} -> Maybe [CacheBehaviorPerPath]
cacheBehaviors) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe [CacheBehaviorPerPath]
a -> UpdateDistribution
s {$sel:cacheBehaviors:UpdateDistribution' :: Maybe [CacheBehaviorPerPath]
cacheBehaviors = Maybe [CacheBehaviorPerPath]
a} :: UpdateDistribution) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An object that describes the default cache behavior for the
-- distribution.
updateDistribution_defaultCacheBehavior :: Lens.Lens' UpdateDistribution (Prelude.Maybe CacheBehavior)
updateDistribution_defaultCacheBehavior :: Lens' UpdateDistribution (Maybe CacheBehavior)
updateDistribution_defaultCacheBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe CacheBehavior
defaultCacheBehavior :: Maybe CacheBehavior
$sel:defaultCacheBehavior:UpdateDistribution' :: UpdateDistribution -> Maybe CacheBehavior
defaultCacheBehavior} -> Maybe CacheBehavior
defaultCacheBehavior) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe CacheBehavior
a -> UpdateDistribution
s {$sel:defaultCacheBehavior:UpdateDistribution' :: Maybe CacheBehavior
defaultCacheBehavior = Maybe CacheBehavior
a} :: UpdateDistribution)

-- | Indicates whether to enable the distribution.
updateDistribution_isEnabled :: Lens.Lens' UpdateDistribution (Prelude.Maybe Prelude.Bool)
updateDistribution_isEnabled :: Lens' UpdateDistribution (Maybe Bool)
updateDistribution_isEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe Bool
isEnabled :: Maybe Bool
$sel:isEnabled:UpdateDistribution' :: UpdateDistribution -> Maybe Bool
isEnabled} -> Maybe Bool
isEnabled) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe Bool
a -> UpdateDistribution
s {$sel:isEnabled:UpdateDistribution' :: Maybe Bool
isEnabled = Maybe Bool
a} :: UpdateDistribution)

-- | An object that describes the origin resource for the distribution, such
-- as a Lightsail instance, bucket, or load balancer.
--
-- The distribution pulls, caches, and serves content from the origin.
updateDistribution_origin :: Lens.Lens' UpdateDistribution (Prelude.Maybe InputOrigin)
updateDistribution_origin :: Lens' UpdateDistribution (Maybe InputOrigin)
updateDistribution_origin = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Maybe InputOrigin
origin :: Maybe InputOrigin
$sel:origin:UpdateDistribution' :: UpdateDistribution -> Maybe InputOrigin
origin} -> Maybe InputOrigin
origin) (\s :: UpdateDistribution
s@UpdateDistribution' {} Maybe InputOrigin
a -> UpdateDistribution
s {$sel:origin:UpdateDistribution' :: Maybe InputOrigin
origin = Maybe InputOrigin
a} :: UpdateDistribution)

-- | The name of the distribution to update.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
updateDistribution_distributionName :: Lens.Lens' UpdateDistribution Prelude.Text
updateDistribution_distributionName :: Lens' UpdateDistribution Text
updateDistribution_distributionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistribution' {Text
distributionName :: Text
$sel:distributionName:UpdateDistribution' :: UpdateDistribution -> Text
distributionName} -> Text
distributionName) (\s :: UpdateDistribution
s@UpdateDistribution' {} Text
a -> UpdateDistribution
s {$sel:distributionName:UpdateDistribution' :: Text
distributionName = 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, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 -> 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 Operation -> Int -> UpdateDistributionResponse
UpdateDistributionResponse'
            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
"operation")
            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 Bool
Maybe [CacheBehaviorPerPath]
Maybe CacheBehavior
Maybe CacheSettings
Maybe InputOrigin
Text
distributionName :: Text
origin :: Maybe InputOrigin
isEnabled :: Maybe Bool
defaultCacheBehavior :: Maybe CacheBehavior
cacheBehaviors :: Maybe [CacheBehaviorPerPath]
cacheBehaviorSettings :: Maybe CacheSettings
$sel:distributionName:UpdateDistribution' :: UpdateDistribution -> Text
$sel:origin:UpdateDistribution' :: UpdateDistribution -> Maybe InputOrigin
$sel:isEnabled:UpdateDistribution' :: UpdateDistribution -> Maybe Bool
$sel:defaultCacheBehavior:UpdateDistribution' :: UpdateDistribution -> Maybe CacheBehavior
$sel:cacheBehaviors:UpdateDistribution' :: UpdateDistribution -> Maybe [CacheBehaviorPerPath]
$sel:cacheBehaviorSettings:UpdateDistribution' :: UpdateDistribution -> Maybe CacheSettings
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CacheSettings
cacheBehaviorSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CacheBehaviorPerPath]
cacheBehaviors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CacheBehavior
defaultCacheBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputOrigin
origin
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
distributionName

instance Prelude.NFData UpdateDistribution where
  rnf :: UpdateDistribution -> ()
rnf UpdateDistribution' {Maybe Bool
Maybe [CacheBehaviorPerPath]
Maybe CacheBehavior
Maybe CacheSettings
Maybe InputOrigin
Text
distributionName :: Text
origin :: Maybe InputOrigin
isEnabled :: Maybe Bool
defaultCacheBehavior :: Maybe CacheBehavior
cacheBehaviors :: Maybe [CacheBehaviorPerPath]
cacheBehaviorSettings :: Maybe CacheSettings
$sel:distributionName:UpdateDistribution' :: UpdateDistribution -> Text
$sel:origin:UpdateDistribution' :: UpdateDistribution -> Maybe InputOrigin
$sel:isEnabled:UpdateDistribution' :: UpdateDistribution -> Maybe Bool
$sel:defaultCacheBehavior:UpdateDistribution' :: UpdateDistribution -> Maybe CacheBehavior
$sel:cacheBehaviors:UpdateDistribution' :: UpdateDistribution -> Maybe [CacheBehaviorPerPath]
$sel:cacheBehaviorSettings:UpdateDistribution' :: UpdateDistribution -> Maybe CacheSettings
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CacheSettings
cacheBehaviorSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CacheBehaviorPerPath]
cacheBehaviors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CacheBehavior
defaultCacheBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputOrigin
origin
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
distributionName

instance Data.ToHeaders UpdateDistribution where
  toHeaders :: UpdateDistribution -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.UpdateDistribution" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDistribution where
  toJSON :: UpdateDistribution -> Value
toJSON UpdateDistribution' {Maybe Bool
Maybe [CacheBehaviorPerPath]
Maybe CacheBehavior
Maybe CacheSettings
Maybe InputOrigin
Text
distributionName :: Text
origin :: Maybe InputOrigin
isEnabled :: Maybe Bool
defaultCacheBehavior :: Maybe CacheBehavior
cacheBehaviors :: Maybe [CacheBehaviorPerPath]
cacheBehaviorSettings :: Maybe CacheSettings
$sel:distributionName:UpdateDistribution' :: UpdateDistribution -> Text
$sel:origin:UpdateDistribution' :: UpdateDistribution -> Maybe InputOrigin
$sel:isEnabled:UpdateDistribution' :: UpdateDistribution -> Maybe Bool
$sel:defaultCacheBehavior:UpdateDistribution' :: UpdateDistribution -> Maybe CacheBehavior
$sel:cacheBehaviors:UpdateDistribution' :: UpdateDistribution -> Maybe [CacheBehaviorPerPath]
$sel:cacheBehaviorSettings:UpdateDistribution' :: UpdateDistribution -> Maybe CacheSettings
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cacheBehaviorSettings" 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 CacheSettings
cacheBehaviorSettings,
            (Key
"cacheBehaviors" 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 [CacheBehaviorPerPath]
cacheBehaviors,
            (Key
"defaultCacheBehavior" 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 CacheBehavior
defaultCacheBehavior,
            (Key
"isEnabled" 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 Bool
isEnabled,
            (Key
"origin" 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 InputOrigin
origin,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"distributionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
distributionName)
          ]
      )

instance Data.ToPath UpdateDistribution where
  toPath :: UpdateDistribution -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateDistributionResponse' smart constructor.
data UpdateDistributionResponse = UpdateDistributionResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    UpdateDistributionResponse -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | 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, ReadPrec [UpdateDistributionResponse]
ReadPrec UpdateDistributionResponse
Int -> ReadS UpdateDistributionResponse
ReadS [UpdateDistributionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDistributionResponse]
$creadListPrec :: ReadPrec [UpdateDistributionResponse]
readPrec :: ReadPrec UpdateDistributionResponse
$creadPrec :: ReadPrec UpdateDistributionResponse
readList :: ReadS [UpdateDistributionResponse]
$creadList :: ReadS [UpdateDistributionResponse]
readsPrec :: Int -> ReadS UpdateDistributionResponse
$creadsPrec :: Int -> ReadS UpdateDistributionResponse
Prelude.Read, 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:
--
-- 'operation', 'updateDistributionResponse_operation' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'updateDistributionResponse_httpStatus' - The response's http status code.
newUpdateDistributionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDistributionResponse
newUpdateDistributionResponse :: Int -> UpdateDistributionResponse
newUpdateDistributionResponse Int
pHttpStatus_ =
  UpdateDistributionResponse'
    { $sel:operation:UpdateDistributionResponse' :: Maybe Operation
operation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDistributionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
updateDistributionResponse_operation :: Lens.Lens' UpdateDistributionResponse (Prelude.Maybe Operation)
updateDistributionResponse_operation :: Lens' UpdateDistributionResponse (Maybe Operation)
updateDistributionResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:UpdateDistributionResponse' :: UpdateDistributionResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: UpdateDistributionResponse
s@UpdateDistributionResponse' {} Maybe Operation
a -> UpdateDistributionResponse
s {$sel:operation:UpdateDistributionResponse' :: Maybe Operation
operation = Maybe Operation
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 Operation
httpStatus :: Int
operation :: Maybe Operation
$sel:httpStatus:UpdateDistributionResponse' :: UpdateDistributionResponse -> Int
$sel:operation:UpdateDistributionResponse' :: UpdateDistributionResponse -> Maybe Operation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Operation
operation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus