{-# 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.AppSync.DisassociateApi
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes an @ApiAssociation@ object from a custom domain.
module Amazonka.AppSync.DisassociateApi
  ( -- * Creating a Request
    DisassociateApi (..),
    newDisassociateApi,

    -- * Request Lenses
    disassociateApi_domainName,

    -- * Destructuring the Response
    DisassociateApiResponse (..),
    newDisassociateApiResponse,

    -- * Response Lenses
    disassociateApiResponse_httpStatus,
  )
where

import Amazonka.AppSync.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:/ 'newDisassociateApi' smart constructor.
data DisassociateApi = DisassociateApi'
  { -- | The domain name.
    DisassociateApi -> Text
domainName :: Prelude.Text
  }
  deriving (DisassociateApi -> DisassociateApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateApi -> DisassociateApi -> Bool
$c/= :: DisassociateApi -> DisassociateApi -> Bool
== :: DisassociateApi -> DisassociateApi -> Bool
$c== :: DisassociateApi -> DisassociateApi -> Bool
Prelude.Eq, ReadPrec [DisassociateApi]
ReadPrec DisassociateApi
Int -> ReadS DisassociateApi
ReadS [DisassociateApi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateApi]
$creadListPrec :: ReadPrec [DisassociateApi]
readPrec :: ReadPrec DisassociateApi
$creadPrec :: ReadPrec DisassociateApi
readList :: ReadS [DisassociateApi]
$creadList :: ReadS [DisassociateApi]
readsPrec :: Int -> ReadS DisassociateApi
$creadsPrec :: Int -> ReadS DisassociateApi
Prelude.Read, Int -> DisassociateApi -> ShowS
[DisassociateApi] -> ShowS
DisassociateApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateApi] -> ShowS
$cshowList :: [DisassociateApi] -> ShowS
show :: DisassociateApi -> String
$cshow :: DisassociateApi -> String
showsPrec :: Int -> DisassociateApi -> ShowS
$cshowsPrec :: Int -> DisassociateApi -> ShowS
Prelude.Show, forall x. Rep DisassociateApi x -> DisassociateApi
forall x. DisassociateApi -> Rep DisassociateApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateApi x -> DisassociateApi
$cfrom :: forall x. DisassociateApi -> Rep DisassociateApi x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateApi' 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:
--
-- 'domainName', 'disassociateApi_domainName' - The domain name.
newDisassociateApi ::
  -- | 'domainName'
  Prelude.Text ->
  DisassociateApi
newDisassociateApi :: Text -> DisassociateApi
newDisassociateApi Text
pDomainName_ =
  DisassociateApi' {$sel:domainName:DisassociateApi' :: Text
domainName = Text
pDomainName_}

-- | The domain name.
disassociateApi_domainName :: Lens.Lens' DisassociateApi Prelude.Text
disassociateApi_domainName :: Lens' DisassociateApi Text
disassociateApi_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateApi' {Text
domainName :: Text
$sel:domainName:DisassociateApi' :: DisassociateApi -> Text
domainName} -> Text
domainName) (\s :: DisassociateApi
s@DisassociateApi' {} Text
a -> DisassociateApi
s {$sel:domainName:DisassociateApi' :: Text
domainName = Text
a} :: DisassociateApi)

instance Core.AWSRequest DisassociateApi where
  type
    AWSResponse DisassociateApi =
      DisassociateApiResponse
  request :: (Service -> Service) -> DisassociateApi -> Request DisassociateApi
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DisassociateApi
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DisassociateApi)))
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 -> DisassociateApiResponse
DisassociateApiResponse'
            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 DisassociateApi where
  hashWithSalt :: Int -> DisassociateApi -> Int
hashWithSalt Int
_salt DisassociateApi' {Text
domainName :: Text
$sel:domainName:DisassociateApi' :: DisassociateApi -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData DisassociateApi where
  rnf :: DisassociateApi -> ()
rnf DisassociateApi' {Text
domainName :: Text
$sel:domainName:DisassociateApi' :: DisassociateApi -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders DisassociateApi where
  toHeaders :: DisassociateApi -> 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.ToPath DisassociateApi where
  toPath :: DisassociateApi -> ByteString
toPath DisassociateApi' {Text
domainName :: Text
$sel:domainName:DisassociateApi' :: DisassociateApi -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/domainnames/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/apiassociation"
      ]

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

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

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

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

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