{-# 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.UpdateDistributionBundle
-- 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 bundle of your Amazon Lightsail content delivery network
-- (CDN) distribution.
--
-- A distribution bundle specifies the monthly network transfer quota and
-- monthly cost of your distribution.
--
-- Update your distribution\'s bundle if your distribution is going over
-- its monthly network transfer quota and is incurring an overage fee.
--
-- You can update your distribution\'s bundle only one time within your
-- monthly Amazon Web Services billing cycle. To determine if you can
-- update your distribution\'s bundle, use the @GetDistributions@ action.
-- The @ableToUpdateBundle@ parameter in the result will indicate whether
-- you can currently update your distribution\'s bundle.
module Amazonka.Lightsail.UpdateDistributionBundle
  ( -- * Creating a Request
    UpdateDistributionBundle (..),
    newUpdateDistributionBundle,

    -- * Request Lenses
    updateDistributionBundle_bundleId,
    updateDistributionBundle_distributionName,

    -- * Destructuring the Response
    UpdateDistributionBundleResponse (..),
    newUpdateDistributionBundleResponse,

    -- * Response Lenses
    updateDistributionBundleResponse_operation,
    updateDistributionBundleResponse_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:/ 'newUpdateDistributionBundle' smart constructor.
data UpdateDistributionBundle = UpdateDistributionBundle'
  { -- | The bundle ID of the new bundle to apply to your distribution.
    --
    -- Use the @GetDistributionBundles@ action to get a list of distribution
    -- bundle IDs that you can specify.
    UpdateDistributionBundle -> Maybe Text
bundleId :: Prelude.Maybe Prelude.Text,
    -- | The name of the distribution for which to update the bundle.
    --
    -- Use the @GetDistributions@ action to get a list of distribution names
    -- that you can specify.
    UpdateDistributionBundle -> Maybe Text
distributionName :: Prelude.Maybe Prelude.Text
  }
  deriving (UpdateDistributionBundle -> UpdateDistributionBundle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDistributionBundle -> UpdateDistributionBundle -> Bool
$c/= :: UpdateDistributionBundle -> UpdateDistributionBundle -> Bool
== :: UpdateDistributionBundle -> UpdateDistributionBundle -> Bool
$c== :: UpdateDistributionBundle -> UpdateDistributionBundle -> Bool
Prelude.Eq, ReadPrec [UpdateDistributionBundle]
ReadPrec UpdateDistributionBundle
Int -> ReadS UpdateDistributionBundle
ReadS [UpdateDistributionBundle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDistributionBundle]
$creadListPrec :: ReadPrec [UpdateDistributionBundle]
readPrec :: ReadPrec UpdateDistributionBundle
$creadPrec :: ReadPrec UpdateDistributionBundle
readList :: ReadS [UpdateDistributionBundle]
$creadList :: ReadS [UpdateDistributionBundle]
readsPrec :: Int -> ReadS UpdateDistributionBundle
$creadsPrec :: Int -> ReadS UpdateDistributionBundle
Prelude.Read, Int -> UpdateDistributionBundle -> ShowS
[UpdateDistributionBundle] -> ShowS
UpdateDistributionBundle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDistributionBundle] -> ShowS
$cshowList :: [UpdateDistributionBundle] -> ShowS
show :: UpdateDistributionBundle -> String
$cshow :: UpdateDistributionBundle -> String
showsPrec :: Int -> UpdateDistributionBundle -> ShowS
$cshowsPrec :: Int -> UpdateDistributionBundle -> ShowS
Prelude.Show, forall x.
Rep UpdateDistributionBundle x -> UpdateDistributionBundle
forall x.
UpdateDistributionBundle -> Rep UpdateDistributionBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDistributionBundle x -> UpdateDistributionBundle
$cfrom :: forall x.
UpdateDistributionBundle -> Rep UpdateDistributionBundle x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDistributionBundle' 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:
--
-- 'bundleId', 'updateDistributionBundle_bundleId' - The bundle ID of the new bundle to apply to your distribution.
--
-- Use the @GetDistributionBundles@ action to get a list of distribution
-- bundle IDs that you can specify.
--
-- 'distributionName', 'updateDistributionBundle_distributionName' - The name of the distribution for which to update the bundle.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
newUpdateDistributionBundle ::
  UpdateDistributionBundle
newUpdateDistributionBundle :: UpdateDistributionBundle
newUpdateDistributionBundle =
  UpdateDistributionBundle'
    { $sel:bundleId:UpdateDistributionBundle' :: Maybe Text
bundleId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:distributionName:UpdateDistributionBundle' :: Maybe Text
distributionName = forall a. Maybe a
Prelude.Nothing
    }

-- | The bundle ID of the new bundle to apply to your distribution.
--
-- Use the @GetDistributionBundles@ action to get a list of distribution
-- bundle IDs that you can specify.
updateDistributionBundle_bundleId :: Lens.Lens' UpdateDistributionBundle (Prelude.Maybe Prelude.Text)
updateDistributionBundle_bundleId :: Lens' UpdateDistributionBundle (Maybe Text)
updateDistributionBundle_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionBundle' {Maybe Text
bundleId :: Maybe Text
$sel:bundleId:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
bundleId} -> Maybe Text
bundleId) (\s :: UpdateDistributionBundle
s@UpdateDistributionBundle' {} Maybe Text
a -> UpdateDistributionBundle
s {$sel:bundleId:UpdateDistributionBundle' :: Maybe Text
bundleId = Maybe Text
a} :: UpdateDistributionBundle)

-- | The name of the distribution for which to update the bundle.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
updateDistributionBundle_distributionName :: Lens.Lens' UpdateDistributionBundle (Prelude.Maybe Prelude.Text)
updateDistributionBundle_distributionName :: Lens' UpdateDistributionBundle (Maybe Text)
updateDistributionBundle_distributionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionBundle' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
distributionName} -> Maybe Text
distributionName) (\s :: UpdateDistributionBundle
s@UpdateDistributionBundle' {} Maybe Text
a -> UpdateDistributionBundle
s {$sel:distributionName:UpdateDistributionBundle' :: Maybe Text
distributionName = Maybe Text
a} :: UpdateDistributionBundle)

instance Core.AWSRequest UpdateDistributionBundle where
  type
    AWSResponse UpdateDistributionBundle =
      UpdateDistributionBundleResponse
  request :: (Service -> Service)
-> UpdateDistributionBundle -> Request UpdateDistributionBundle
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 UpdateDistributionBundle
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDistributionBundle)))
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 -> UpdateDistributionBundleResponse
UpdateDistributionBundleResponse'
            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 UpdateDistributionBundle where
  hashWithSalt :: Int -> UpdateDistributionBundle -> Int
hashWithSalt Int
_salt UpdateDistributionBundle' {Maybe Text
distributionName :: Maybe Text
bundleId :: Maybe Text
$sel:distributionName:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
$sel:bundleId:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bundleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
distributionName

instance Prelude.NFData UpdateDistributionBundle where
  rnf :: UpdateDistributionBundle -> ()
rnf UpdateDistributionBundle' {Maybe Text
distributionName :: Maybe Text
bundleId :: Maybe Text
$sel:distributionName:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
$sel:bundleId:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bundleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
distributionName

instance Data.ToHeaders UpdateDistributionBundle where
  toHeaders :: UpdateDistributionBundle -> 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.UpdateDistributionBundle" ::
                          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 UpdateDistributionBundle where
  toJSON :: UpdateDistributionBundle -> Value
toJSON UpdateDistributionBundle' {Maybe Text
distributionName :: Maybe Text
bundleId :: Maybe Text
$sel:distributionName:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
$sel:bundleId:UpdateDistributionBundle' :: UpdateDistributionBundle -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"bundleId" 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 Text
bundleId,
            (Key
"distributionName" 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 Text
distributionName
          ]
      )

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

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

-- | /See:/ 'newUpdateDistributionBundleResponse' smart constructor.
data UpdateDistributionBundleResponse = UpdateDistributionBundleResponse'
  { -- | An object that describes the result of the action, such as the status of
    -- the request, the timestamp of the request, and the resources affected by
    -- the request.
    UpdateDistributionBundleResponse -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | The response's http status code.
    UpdateDistributionBundleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDistributionBundleResponse
-> UpdateDistributionBundleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDistributionBundleResponse
-> UpdateDistributionBundleResponse -> Bool
$c/= :: UpdateDistributionBundleResponse
-> UpdateDistributionBundleResponse -> Bool
== :: UpdateDistributionBundleResponse
-> UpdateDistributionBundleResponse -> Bool
$c== :: UpdateDistributionBundleResponse
-> UpdateDistributionBundleResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDistributionBundleResponse]
ReadPrec UpdateDistributionBundleResponse
Int -> ReadS UpdateDistributionBundleResponse
ReadS [UpdateDistributionBundleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDistributionBundleResponse]
$creadListPrec :: ReadPrec [UpdateDistributionBundleResponse]
readPrec :: ReadPrec UpdateDistributionBundleResponse
$creadPrec :: ReadPrec UpdateDistributionBundleResponse
readList :: ReadS [UpdateDistributionBundleResponse]
$creadList :: ReadS [UpdateDistributionBundleResponse]
readsPrec :: Int -> ReadS UpdateDistributionBundleResponse
$creadsPrec :: Int -> ReadS UpdateDistributionBundleResponse
Prelude.Read, Int -> UpdateDistributionBundleResponse -> ShowS
[UpdateDistributionBundleResponse] -> ShowS
UpdateDistributionBundleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDistributionBundleResponse] -> ShowS
$cshowList :: [UpdateDistributionBundleResponse] -> ShowS
show :: UpdateDistributionBundleResponse -> String
$cshow :: UpdateDistributionBundleResponse -> String
showsPrec :: Int -> UpdateDistributionBundleResponse -> ShowS
$cshowsPrec :: Int -> UpdateDistributionBundleResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDistributionBundleResponse x
-> UpdateDistributionBundleResponse
forall x.
UpdateDistributionBundleResponse
-> Rep UpdateDistributionBundleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDistributionBundleResponse x
-> UpdateDistributionBundleResponse
$cfrom :: forall x.
UpdateDistributionBundleResponse
-> Rep UpdateDistributionBundleResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDistributionBundleResponse' 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', 'updateDistributionBundleResponse_operation' - An object that describes 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', 'updateDistributionBundleResponse_httpStatus' - The response's http status code.
newUpdateDistributionBundleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDistributionBundleResponse
newUpdateDistributionBundleResponse :: Int -> UpdateDistributionBundleResponse
newUpdateDistributionBundleResponse Int
pHttpStatus_ =
  UpdateDistributionBundleResponse'
    { $sel:operation:UpdateDistributionBundleResponse' :: Maybe Operation
operation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDistributionBundleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes the result of the action, such as the status of
-- the request, the timestamp of the request, and the resources affected by
-- the request.
updateDistributionBundleResponse_operation :: Lens.Lens' UpdateDistributionBundleResponse (Prelude.Maybe Operation)
updateDistributionBundleResponse_operation :: Lens' UpdateDistributionBundleResponse (Maybe Operation)
updateDistributionBundleResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDistributionBundleResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:UpdateDistributionBundleResponse' :: UpdateDistributionBundleResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: UpdateDistributionBundleResponse
s@UpdateDistributionBundleResponse' {} Maybe Operation
a -> UpdateDistributionBundleResponse
s {$sel:operation:UpdateDistributionBundleResponse' :: Maybe Operation
operation = Maybe Operation
a} :: UpdateDistributionBundleResponse)

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

instance
  Prelude.NFData
    UpdateDistributionBundleResponse
  where
  rnf :: UpdateDistributionBundleResponse -> ()
rnf UpdateDistributionBundleResponse' {Int
Maybe Operation
httpStatus :: Int
operation :: Maybe Operation
$sel:httpStatus:UpdateDistributionBundleResponse' :: UpdateDistributionBundleResponse -> Int
$sel:operation:UpdateDistributionBundleResponse' :: UpdateDistributionBundleResponse -> 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