{-# 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.ServiceCatalog.DisassociateBudgetFromResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates the specified budget from the specified resource.
module Amazonka.ServiceCatalog.DisassociateBudgetFromResource
  ( -- * Creating a Request
    DisassociateBudgetFromResource (..),
    newDisassociateBudgetFromResource,

    -- * Request Lenses
    disassociateBudgetFromResource_budgetName,
    disassociateBudgetFromResource_resourceId,

    -- * Destructuring the Response
    DisassociateBudgetFromResourceResponse (..),
    newDisassociateBudgetFromResourceResponse,

    -- * Response Lenses
    disassociateBudgetFromResourceResponse_httpStatus,
  )
where

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
import Amazonka.ServiceCatalog.Types

-- | /See:/ 'newDisassociateBudgetFromResource' smart constructor.
data DisassociateBudgetFromResource = DisassociateBudgetFromResource'
  { -- | The name of the budget you want to disassociate.
    DisassociateBudgetFromResource -> Text
budgetName :: Prelude.Text,
    -- | The resource identifier you want to disassociate from. Either a
    -- portfolio-id or a product-id.
    DisassociateBudgetFromResource -> Text
resourceId :: Prelude.Text
  }
  deriving (DisassociateBudgetFromResource
-> DisassociateBudgetFromResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateBudgetFromResource
-> DisassociateBudgetFromResource -> Bool
$c/= :: DisassociateBudgetFromResource
-> DisassociateBudgetFromResource -> Bool
== :: DisassociateBudgetFromResource
-> DisassociateBudgetFromResource -> Bool
$c== :: DisassociateBudgetFromResource
-> DisassociateBudgetFromResource -> Bool
Prelude.Eq, ReadPrec [DisassociateBudgetFromResource]
ReadPrec DisassociateBudgetFromResource
Int -> ReadS DisassociateBudgetFromResource
ReadS [DisassociateBudgetFromResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateBudgetFromResource]
$creadListPrec :: ReadPrec [DisassociateBudgetFromResource]
readPrec :: ReadPrec DisassociateBudgetFromResource
$creadPrec :: ReadPrec DisassociateBudgetFromResource
readList :: ReadS [DisassociateBudgetFromResource]
$creadList :: ReadS [DisassociateBudgetFromResource]
readsPrec :: Int -> ReadS DisassociateBudgetFromResource
$creadsPrec :: Int -> ReadS DisassociateBudgetFromResource
Prelude.Read, Int -> DisassociateBudgetFromResource -> ShowS
[DisassociateBudgetFromResource] -> ShowS
DisassociateBudgetFromResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateBudgetFromResource] -> ShowS
$cshowList :: [DisassociateBudgetFromResource] -> ShowS
show :: DisassociateBudgetFromResource -> String
$cshow :: DisassociateBudgetFromResource -> String
showsPrec :: Int -> DisassociateBudgetFromResource -> ShowS
$cshowsPrec :: Int -> DisassociateBudgetFromResource -> ShowS
Prelude.Show, forall x.
Rep DisassociateBudgetFromResource x
-> DisassociateBudgetFromResource
forall x.
DisassociateBudgetFromResource
-> Rep DisassociateBudgetFromResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateBudgetFromResource x
-> DisassociateBudgetFromResource
$cfrom :: forall x.
DisassociateBudgetFromResource
-> Rep DisassociateBudgetFromResource x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateBudgetFromResource' 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:
--
-- 'budgetName', 'disassociateBudgetFromResource_budgetName' - The name of the budget you want to disassociate.
--
-- 'resourceId', 'disassociateBudgetFromResource_resourceId' - The resource identifier you want to disassociate from. Either a
-- portfolio-id or a product-id.
newDisassociateBudgetFromResource ::
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  DisassociateBudgetFromResource
newDisassociateBudgetFromResource :: Text -> Text -> DisassociateBudgetFromResource
newDisassociateBudgetFromResource
  Text
pBudgetName_
  Text
pResourceId_ =
    DisassociateBudgetFromResource'
      { $sel:budgetName:DisassociateBudgetFromResource' :: Text
budgetName =
          Text
pBudgetName_,
        $sel:resourceId:DisassociateBudgetFromResource' :: Text
resourceId = Text
pResourceId_
      }

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

-- | The resource identifier you want to disassociate from. Either a
-- portfolio-id or a product-id.
disassociateBudgetFromResource_resourceId :: Lens.Lens' DisassociateBudgetFromResource Prelude.Text
disassociateBudgetFromResource_resourceId :: Lens' DisassociateBudgetFromResource Text
disassociateBudgetFromResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateBudgetFromResource' {Text
resourceId :: Text
$sel:resourceId:DisassociateBudgetFromResource' :: DisassociateBudgetFromResource -> Text
resourceId} -> Text
resourceId) (\s :: DisassociateBudgetFromResource
s@DisassociateBudgetFromResource' {} Text
a -> DisassociateBudgetFromResource
s {$sel:resourceId:DisassociateBudgetFromResource' :: Text
resourceId = Text
a} :: DisassociateBudgetFromResource)

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

instance
  Prelude.NFData
    DisassociateBudgetFromResource
  where
  rnf :: DisassociateBudgetFromResource -> ()
rnf DisassociateBudgetFromResource' {Text
resourceId :: Text
budgetName :: Text
$sel:resourceId:DisassociateBudgetFromResource' :: DisassociateBudgetFromResource -> Text
$sel:budgetName:DisassociateBudgetFromResource' :: DisassociateBudgetFromResource -> Text
..} =
    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 Text
resourceId

instance
  Data.ToHeaders
    DisassociateBudgetFromResource
  where
  toHeaders :: DisassociateBudgetFromResource -> 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
"AWS242ServiceCatalogService.DisassociateBudgetFromResource" ::
                          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 DisassociateBudgetFromResource where
  toJSON :: DisassociateBudgetFromResource -> Value
toJSON DisassociateBudgetFromResource' {Text
resourceId :: Text
budgetName :: Text
$sel:resourceId:DisassociateBudgetFromResource' :: DisassociateBudgetFromResource -> Text
$sel:budgetName:DisassociateBudgetFromResource' :: DisassociateBudgetFromResource -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId)
          ]
      )

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

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

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

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

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

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