{-# 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.CloudFormation.DeactivateType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deactivates a public extension that was previously activated in this
-- account and region.
--
-- Once deactivated, an extension can\'t be used in any CloudFormation
-- operation. This includes stack update operations where the stack
-- template includes the extension, even if no updates are being made to
-- the extension. In addition, deactivated extensions aren\'t automatically
-- updated if a new version of the extension is released.
module Amazonka.CloudFormation.DeactivateType
  ( -- * Creating a Request
    DeactivateType (..),
    newDeactivateType,

    -- * Request Lenses
    deactivateType_arn,
    deactivateType_type,
    deactivateType_typeName,

    -- * Destructuring the Response
    DeactivateTypeResponse (..),
    newDeactivateTypeResponse,

    -- * Response Lenses
    deactivateTypeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeactivateType' smart constructor.
data DeactivateType = DeactivateType'
  { -- | The Amazon Resource Name (ARN) for the extension, in this account and
    -- region.
    --
    -- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
    DeactivateType -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The extension type.
    --
    -- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
    DeactivateType -> Maybe ThirdPartyType
type' :: Prelude.Maybe ThirdPartyType,
    -- | The type name of the extension, in this account and region. If you
    -- specified a type name alias when enabling the extension, use the type
    -- name alias.
    --
    -- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
    DeactivateType -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text
  }
  deriving (DeactivateType -> DeactivateType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeactivateType -> DeactivateType -> Bool
$c/= :: DeactivateType -> DeactivateType -> Bool
== :: DeactivateType -> DeactivateType -> Bool
$c== :: DeactivateType -> DeactivateType -> Bool
Prelude.Eq, ReadPrec [DeactivateType]
ReadPrec DeactivateType
Int -> ReadS DeactivateType
ReadS [DeactivateType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeactivateType]
$creadListPrec :: ReadPrec [DeactivateType]
readPrec :: ReadPrec DeactivateType
$creadPrec :: ReadPrec DeactivateType
readList :: ReadS [DeactivateType]
$creadList :: ReadS [DeactivateType]
readsPrec :: Int -> ReadS DeactivateType
$creadsPrec :: Int -> ReadS DeactivateType
Prelude.Read, Int -> DeactivateType -> ShowS
[DeactivateType] -> ShowS
DeactivateType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeactivateType] -> ShowS
$cshowList :: [DeactivateType] -> ShowS
show :: DeactivateType -> String
$cshow :: DeactivateType -> String
showsPrec :: Int -> DeactivateType -> ShowS
$cshowsPrec :: Int -> DeactivateType -> ShowS
Prelude.Show, forall x. Rep DeactivateType x -> DeactivateType
forall x. DeactivateType -> Rep DeactivateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeactivateType x -> DeactivateType
$cfrom :: forall x. DeactivateType -> Rep DeactivateType x
Prelude.Generic)

-- |
-- Create a value of 'DeactivateType' 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:
--
-- 'arn', 'deactivateType_arn' - The Amazon Resource Name (ARN) for the extension, in this account and
-- region.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
--
-- 'type'', 'deactivateType_type' - The extension type.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
--
-- 'typeName', 'deactivateType_typeName' - The type name of the extension, in this account and region. If you
-- specified a type name alias when enabling the extension, use the type
-- name alias.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
newDeactivateType ::
  DeactivateType
newDeactivateType :: DeactivateType
newDeactivateType =
  DeactivateType'
    { $sel:arn:DeactivateType' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:type':DeactivateType' :: Maybe ThirdPartyType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:DeactivateType' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) for the extension, in this account and
-- region.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
deactivateType_arn :: Lens.Lens' DeactivateType (Prelude.Maybe Prelude.Text)
deactivateType_arn :: Lens' DeactivateType (Maybe Text)
deactivateType_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeactivateType' {Maybe Text
arn :: Maybe Text
$sel:arn:DeactivateType' :: DeactivateType -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DeactivateType
s@DeactivateType' {} Maybe Text
a -> DeactivateType
s {$sel:arn:DeactivateType' :: Maybe Text
arn = Maybe Text
a} :: DeactivateType)

-- | The extension type.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
deactivateType_type :: Lens.Lens' DeactivateType (Prelude.Maybe ThirdPartyType)
deactivateType_type :: Lens' DeactivateType (Maybe ThirdPartyType)
deactivateType_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeactivateType' {Maybe ThirdPartyType
type' :: Maybe ThirdPartyType
$sel:type':DeactivateType' :: DeactivateType -> Maybe ThirdPartyType
type'} -> Maybe ThirdPartyType
type') (\s :: DeactivateType
s@DeactivateType' {} Maybe ThirdPartyType
a -> DeactivateType
s {$sel:type':DeactivateType' :: Maybe ThirdPartyType
type' = Maybe ThirdPartyType
a} :: DeactivateType)

-- | The type name of the extension, in this account and region. If you
-- specified a type name alias when enabling the extension, use the type
-- name alias.
--
-- Conditional: You must specify either @Arn@, or @TypeName@ and @Type@.
deactivateType_typeName :: Lens.Lens' DeactivateType (Prelude.Maybe Prelude.Text)
deactivateType_typeName :: Lens' DeactivateType (Maybe Text)
deactivateType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeactivateType' {Maybe Text
typeName :: Maybe Text
$sel:typeName:DeactivateType' :: DeactivateType -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: DeactivateType
s@DeactivateType' {} Maybe Text
a -> DeactivateType
s {$sel:typeName:DeactivateType' :: Maybe Text
typeName = Maybe Text
a} :: DeactivateType)

instance Core.AWSRequest DeactivateType where
  type
    AWSResponse DeactivateType =
      DeactivateTypeResponse
  request :: (Service -> Service) -> DeactivateType -> Request DeactivateType
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeactivateType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeactivateType)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DeactivateTypeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> DeactivateTypeResponse
DeactivateTypeResponse'
            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 DeactivateType where
  hashWithSalt :: Int -> DeactivateType -> Int
hashWithSalt Int
_salt DeactivateType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
arn :: Maybe Text
$sel:typeName:DeactivateType' :: DeactivateType -> Maybe Text
$sel:type':DeactivateType' :: DeactivateType -> Maybe ThirdPartyType
$sel:arn:DeactivateType' :: DeactivateType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThirdPartyType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName

instance Prelude.NFData DeactivateType where
  rnf :: DeactivateType -> ()
rnf DeactivateType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
arn :: Maybe Text
$sel:typeName:DeactivateType' :: DeactivateType -> Maybe Text
$sel:type':DeactivateType' :: DeactivateType -> Maybe ThirdPartyType
$sel:arn:DeactivateType' :: DeactivateType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThirdPartyType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeName

instance Data.ToHeaders DeactivateType where
  toHeaders :: DeactivateType -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeactivateType where
  toQuery :: DeactivateType -> QueryString
toQuery DeactivateType' {Maybe Text
Maybe ThirdPartyType
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
arn :: Maybe Text
$sel:typeName:DeactivateType' :: DeactivateType -> Maybe Text
$sel:type':DeactivateType' :: DeactivateType -> Maybe ThirdPartyType
$sel:arn:DeactivateType' :: DeactivateType -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeactivateType" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"Arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
arn,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ThirdPartyType
type',
        ByteString
"TypeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeName
      ]

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

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

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

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