{-# 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.Budgets.UpdateNotification
-- 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 notification.
module Amazonka.Budgets.UpdateNotification
  ( -- * Creating a Request
    UpdateNotification (..),
    newUpdateNotification,

    -- * Request Lenses
    updateNotification_accountId,
    updateNotification_budgetName,
    updateNotification_oldNotification,
    updateNotification_newNotification,

    -- * Destructuring the Response
    UpdateNotificationResponse (..),
    newUpdateNotificationResponse,

    -- * Response Lenses
    updateNotificationResponse_httpStatus,
  )
where

import Amazonka.Budgets.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

-- | Request of UpdateNotification
--
-- /See:/ 'newUpdateNotification' smart constructor.
data UpdateNotification = UpdateNotification'
  { -- | The @accountId@ that is associated with the budget whose notification
    -- you want to update.
    UpdateNotification -> Text
accountId :: Prelude.Text,
    -- | The name of the budget whose notification you want to update.
    UpdateNotification -> Text
budgetName :: Prelude.Text,
    -- | The previous notification that is associated with a budget.
    UpdateNotification -> Notification
oldNotification :: Notification,
    -- | The updated notification to be associated with a budget.
    UpdateNotification -> Notification
newNotification' :: Notification
  }
  deriving (UpdateNotification -> UpdateNotification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotification -> UpdateNotification -> Bool
$c/= :: UpdateNotification -> UpdateNotification -> Bool
== :: UpdateNotification -> UpdateNotification -> Bool
$c== :: UpdateNotification -> UpdateNotification -> Bool
Prelude.Eq, ReadPrec [UpdateNotification]
ReadPrec UpdateNotification
Int -> ReadS UpdateNotification
ReadS [UpdateNotification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotification]
$creadListPrec :: ReadPrec [UpdateNotification]
readPrec :: ReadPrec UpdateNotification
$creadPrec :: ReadPrec UpdateNotification
readList :: ReadS [UpdateNotification]
$creadList :: ReadS [UpdateNotification]
readsPrec :: Int -> ReadS UpdateNotification
$creadsPrec :: Int -> ReadS UpdateNotification
Prelude.Read, Int -> UpdateNotification -> ShowS
[UpdateNotification] -> ShowS
UpdateNotification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotification] -> ShowS
$cshowList :: [UpdateNotification] -> ShowS
show :: UpdateNotification -> String
$cshow :: UpdateNotification -> String
showsPrec :: Int -> UpdateNotification -> ShowS
$cshowsPrec :: Int -> UpdateNotification -> ShowS
Prelude.Show, forall x. Rep UpdateNotification x -> UpdateNotification
forall x. UpdateNotification -> Rep UpdateNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateNotification x -> UpdateNotification
$cfrom :: forall x. UpdateNotification -> Rep UpdateNotification x
Prelude.Generic)

-- |
-- Create a value of 'UpdateNotification' 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:
--
-- 'accountId', 'updateNotification_accountId' - The @accountId@ that is associated with the budget whose notification
-- you want to update.
--
-- 'budgetName', 'updateNotification_budgetName' - The name of the budget whose notification you want to update.
--
-- 'oldNotification', 'updateNotification_oldNotification' - The previous notification that is associated with a budget.
--
-- 'newNotification'', 'updateNotification_newNotification' - The updated notification to be associated with a budget.
newUpdateNotification ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'oldNotification'
  Notification ->
  -- | 'newNotification''
  Notification ->
  UpdateNotification
newUpdateNotification :: Text -> Text -> Notification -> Notification -> UpdateNotification
newUpdateNotification
  Text
pAccountId_
  Text
pBudgetName_
  Notification
pOldNotification_
  Notification
pNewNotification_ =
    UpdateNotification'
      { $sel:accountId:UpdateNotification' :: Text
accountId = Text
pAccountId_,
        $sel:budgetName:UpdateNotification' :: Text
budgetName = Text
pBudgetName_,
        $sel:oldNotification:UpdateNotification' :: Notification
oldNotification = Notification
pOldNotification_,
        $sel:newNotification':UpdateNotification' :: Notification
newNotification' = Notification
pNewNotification_
      }

-- | The @accountId@ that is associated with the budget whose notification
-- you want to update.
updateNotification_accountId :: Lens.Lens' UpdateNotification Prelude.Text
updateNotification_accountId :: Lens' UpdateNotification Text
updateNotification_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotification' {Text
accountId :: Text
$sel:accountId:UpdateNotification' :: UpdateNotification -> Text
accountId} -> Text
accountId) (\s :: UpdateNotification
s@UpdateNotification' {} Text
a -> UpdateNotification
s {$sel:accountId:UpdateNotification' :: Text
accountId = Text
a} :: UpdateNotification)

-- | The name of the budget whose notification you want to update.
updateNotification_budgetName :: Lens.Lens' UpdateNotification Prelude.Text
updateNotification_budgetName :: Lens' UpdateNotification Text
updateNotification_budgetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotification' {Text
budgetName :: Text
$sel:budgetName:UpdateNotification' :: UpdateNotification -> Text
budgetName} -> Text
budgetName) (\s :: UpdateNotification
s@UpdateNotification' {} Text
a -> UpdateNotification
s {$sel:budgetName:UpdateNotification' :: Text
budgetName = Text
a} :: UpdateNotification)

-- | The previous notification that is associated with a budget.
updateNotification_oldNotification :: Lens.Lens' UpdateNotification Notification
updateNotification_oldNotification :: Lens' UpdateNotification Notification
updateNotification_oldNotification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotification' {Notification
oldNotification :: Notification
$sel:oldNotification:UpdateNotification' :: UpdateNotification -> Notification
oldNotification} -> Notification
oldNotification) (\s :: UpdateNotification
s@UpdateNotification' {} Notification
a -> UpdateNotification
s {$sel:oldNotification:UpdateNotification' :: Notification
oldNotification = Notification
a} :: UpdateNotification)

-- | The updated notification to be associated with a budget.
updateNotification_newNotification :: Lens.Lens' UpdateNotification Notification
updateNotification_newNotification :: Lens' UpdateNotification Notification
updateNotification_newNotification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotification' {Notification
newNotification' :: Notification
$sel:newNotification':UpdateNotification' :: UpdateNotification -> Notification
newNotification'} -> Notification
newNotification') (\s :: UpdateNotification
s@UpdateNotification' {} Notification
a -> UpdateNotification
s {$sel:newNotification':UpdateNotification' :: Notification
newNotification' = Notification
a} :: UpdateNotification)

instance Core.AWSRequest UpdateNotification where
  type
    AWSResponse UpdateNotification =
      UpdateNotificationResponse
  request :: (Service -> Service)
-> UpdateNotification -> Request UpdateNotification
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 UpdateNotification
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateNotification)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateNotificationResponse
UpdateNotificationResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateNotification where
  hashWithSalt :: Int -> UpdateNotification -> Int
hashWithSalt Int
_salt UpdateNotification' {Text
Notification
newNotification' :: Notification
oldNotification :: Notification
budgetName :: Text
accountId :: Text
$sel:newNotification':UpdateNotification' :: UpdateNotification -> Notification
$sel:oldNotification:UpdateNotification' :: UpdateNotification -> Notification
$sel:budgetName:UpdateNotification' :: UpdateNotification -> Text
$sel:accountId:UpdateNotification' :: UpdateNotification -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
budgetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Notification
oldNotification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Notification
newNotification'

instance Prelude.NFData UpdateNotification where
  rnf :: UpdateNotification -> ()
rnf UpdateNotification' {Text
Notification
newNotification' :: Notification
oldNotification :: Notification
budgetName :: Text
accountId :: Text
$sel:newNotification':UpdateNotification' :: UpdateNotification -> Notification
$sel:oldNotification:UpdateNotification' :: UpdateNotification -> Notification
$sel:budgetName:UpdateNotification' :: UpdateNotification -> Text
$sel:accountId:UpdateNotification' :: UpdateNotification -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
budgetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Notification
oldNotification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Notification
newNotification'

instance Data.ToHeaders UpdateNotification where
  toHeaders :: UpdateNotification -> 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
"AWSBudgetServiceGateway.UpdateNotification" ::
                          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 UpdateNotification where
  toJSON :: UpdateNotification -> Value
toJSON UpdateNotification' {Text
Notification
newNotification' :: Notification
oldNotification :: Notification
budgetName :: Text
accountId :: Text
$sel:newNotification':UpdateNotification' :: UpdateNotification -> Notification
$sel:oldNotification:UpdateNotification' :: UpdateNotification -> Notification
$sel:budgetName:UpdateNotification' :: UpdateNotification -> Text
$sel:accountId:UpdateNotification' :: UpdateNotification -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"AccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
accountId),
            forall a. a -> Maybe a
Prelude.Just (Key
"BudgetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
budgetName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OldNotification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Notification
oldNotification),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"NewNotification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Notification
newNotification')
          ]
      )

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

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

-- | Response of UpdateNotification
--
-- /See:/ 'newUpdateNotificationResponse' smart constructor.
data UpdateNotificationResponse = UpdateNotificationResponse'
  { -- | The response's http status code.
    UpdateNotificationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateNotificationResponse -> UpdateNotificationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotificationResponse -> UpdateNotificationResponse -> Bool
$c/= :: UpdateNotificationResponse -> UpdateNotificationResponse -> Bool
== :: UpdateNotificationResponse -> UpdateNotificationResponse -> Bool
$c== :: UpdateNotificationResponse -> UpdateNotificationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateNotificationResponse]
ReadPrec UpdateNotificationResponse
Int -> ReadS UpdateNotificationResponse
ReadS [UpdateNotificationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotificationResponse]
$creadListPrec :: ReadPrec [UpdateNotificationResponse]
readPrec :: ReadPrec UpdateNotificationResponse
$creadPrec :: ReadPrec UpdateNotificationResponse
readList :: ReadS [UpdateNotificationResponse]
$creadList :: ReadS [UpdateNotificationResponse]
readsPrec :: Int -> ReadS UpdateNotificationResponse
$creadsPrec :: Int -> ReadS UpdateNotificationResponse
Prelude.Read, Int -> UpdateNotificationResponse -> ShowS
[UpdateNotificationResponse] -> ShowS
UpdateNotificationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotificationResponse] -> ShowS
$cshowList :: [UpdateNotificationResponse] -> ShowS
show :: UpdateNotificationResponse -> String
$cshow :: UpdateNotificationResponse -> String
showsPrec :: Int -> UpdateNotificationResponse -> ShowS
$cshowsPrec :: Int -> UpdateNotificationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateNotificationResponse x -> UpdateNotificationResponse
forall x.
UpdateNotificationResponse -> Rep UpdateNotificationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateNotificationResponse x -> UpdateNotificationResponse
$cfrom :: forall x.
UpdateNotificationResponse -> Rep UpdateNotificationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateNotificationResponse' 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:
--
-- 'httpStatus', 'updateNotificationResponse_httpStatus' - The response's http status code.
newUpdateNotificationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateNotificationResponse
newUpdateNotificationResponse :: Int -> UpdateNotificationResponse
newUpdateNotificationResponse Int
pHttpStatus_ =
  UpdateNotificationResponse'
    { $sel:httpStatus:UpdateNotificationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateNotificationResponse where
  rnf :: UpdateNotificationResponse -> ()
rnf UpdateNotificationResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateNotificationResponse' :: UpdateNotificationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus