{-# 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.AppFlow.UnregisterConnector
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Unregisters the custom connector registered in your account that matches
-- the connector label provided in the request.
module Amazonka.AppFlow.UnregisterConnector
  ( -- * Creating a Request
    UnregisterConnector (..),
    newUnregisterConnector,

    -- * Request Lenses
    unregisterConnector_forceDelete,
    unregisterConnector_connectorLabel,

    -- * Destructuring the Response
    UnregisterConnectorResponse (..),
    newUnregisterConnectorResponse,

    -- * Response Lenses
    unregisterConnectorResponse_httpStatus,
  )
where

import Amazonka.AppFlow.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:/ 'newUnregisterConnector' smart constructor.
data UnregisterConnector = UnregisterConnector'
  { -- | Indicates whether Amazon AppFlow should unregister the connector, even
    -- if it is currently in use in one or more connector profiles. The default
    -- value is false.
    UnregisterConnector -> Maybe Bool
forceDelete :: Prelude.Maybe Prelude.Bool,
    -- | The label of the connector. The label is unique for each
    -- @ConnectorRegistration@ in your Amazon Web Services account.
    UnregisterConnector -> Text
connectorLabel :: Prelude.Text
  }
  deriving (UnregisterConnector -> UnregisterConnector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnregisterConnector -> UnregisterConnector -> Bool
$c/= :: UnregisterConnector -> UnregisterConnector -> Bool
== :: UnregisterConnector -> UnregisterConnector -> Bool
$c== :: UnregisterConnector -> UnregisterConnector -> Bool
Prelude.Eq, ReadPrec [UnregisterConnector]
ReadPrec UnregisterConnector
Int -> ReadS UnregisterConnector
ReadS [UnregisterConnector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnregisterConnector]
$creadListPrec :: ReadPrec [UnregisterConnector]
readPrec :: ReadPrec UnregisterConnector
$creadPrec :: ReadPrec UnregisterConnector
readList :: ReadS [UnregisterConnector]
$creadList :: ReadS [UnregisterConnector]
readsPrec :: Int -> ReadS UnregisterConnector
$creadsPrec :: Int -> ReadS UnregisterConnector
Prelude.Read, Int -> UnregisterConnector -> ShowS
[UnregisterConnector] -> ShowS
UnregisterConnector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnregisterConnector] -> ShowS
$cshowList :: [UnregisterConnector] -> ShowS
show :: UnregisterConnector -> String
$cshow :: UnregisterConnector -> String
showsPrec :: Int -> UnregisterConnector -> ShowS
$cshowsPrec :: Int -> UnregisterConnector -> ShowS
Prelude.Show, forall x. Rep UnregisterConnector x -> UnregisterConnector
forall x. UnregisterConnector -> Rep UnregisterConnector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnregisterConnector x -> UnregisterConnector
$cfrom :: forall x. UnregisterConnector -> Rep UnregisterConnector x
Prelude.Generic)

-- |
-- Create a value of 'UnregisterConnector' 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:
--
-- 'forceDelete', 'unregisterConnector_forceDelete' - Indicates whether Amazon AppFlow should unregister the connector, even
-- if it is currently in use in one or more connector profiles. The default
-- value is false.
--
-- 'connectorLabel', 'unregisterConnector_connectorLabel' - The label of the connector. The label is unique for each
-- @ConnectorRegistration@ in your Amazon Web Services account.
newUnregisterConnector ::
  -- | 'connectorLabel'
  Prelude.Text ->
  UnregisterConnector
newUnregisterConnector :: Text -> UnregisterConnector
newUnregisterConnector Text
pConnectorLabel_ =
  UnregisterConnector'
    { $sel:forceDelete:UnregisterConnector' :: Maybe Bool
forceDelete = forall a. Maybe a
Prelude.Nothing,
      $sel:connectorLabel:UnregisterConnector' :: Text
connectorLabel = Text
pConnectorLabel_
    }

-- | Indicates whether Amazon AppFlow should unregister the connector, even
-- if it is currently in use in one or more connector profiles. The default
-- value is false.
unregisterConnector_forceDelete :: Lens.Lens' UnregisterConnector (Prelude.Maybe Prelude.Bool)
unregisterConnector_forceDelete :: Lens' UnregisterConnector (Maybe Bool)
unregisterConnector_forceDelete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnregisterConnector' {Maybe Bool
forceDelete :: Maybe Bool
$sel:forceDelete:UnregisterConnector' :: UnregisterConnector -> Maybe Bool
forceDelete} -> Maybe Bool
forceDelete) (\s :: UnregisterConnector
s@UnregisterConnector' {} Maybe Bool
a -> UnregisterConnector
s {$sel:forceDelete:UnregisterConnector' :: Maybe Bool
forceDelete = Maybe Bool
a} :: UnregisterConnector)

-- | The label of the connector. The label is unique for each
-- @ConnectorRegistration@ in your Amazon Web Services account.
unregisterConnector_connectorLabel :: Lens.Lens' UnregisterConnector Prelude.Text
unregisterConnector_connectorLabel :: Lens' UnregisterConnector Text
unregisterConnector_connectorLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnregisterConnector' {Text
connectorLabel :: Text
$sel:connectorLabel:UnregisterConnector' :: UnregisterConnector -> Text
connectorLabel} -> Text
connectorLabel) (\s :: UnregisterConnector
s@UnregisterConnector' {} Text
a -> UnregisterConnector
s {$sel:connectorLabel:UnregisterConnector' :: Text
connectorLabel = Text
a} :: UnregisterConnector)

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

instance Prelude.NFData UnregisterConnector where
  rnf :: UnregisterConnector -> ()
rnf UnregisterConnector' {Maybe Bool
Text
connectorLabel :: Text
forceDelete :: Maybe Bool
$sel:connectorLabel:UnregisterConnector' :: UnregisterConnector -> Text
$sel:forceDelete:UnregisterConnector' :: UnregisterConnector -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
forceDelete
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectorLabel

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

instance Data.ToJSON UnregisterConnector where
  toJSON :: UnregisterConnector -> Value
toJSON UnregisterConnector' {Maybe Bool
Text
connectorLabel :: Text
forceDelete :: Maybe Bool
$sel:connectorLabel:UnregisterConnector' :: UnregisterConnector -> Text
$sel:forceDelete:UnregisterConnector' :: UnregisterConnector -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"forceDelete" 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
forceDelete,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"connectorLabel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorLabel)
          ]
      )

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

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

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

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

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

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