{-# 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.Amplify.DeleteDomainAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a domain association for an Amplify app.
module Amazonka.Amplify.DeleteDomainAssociation
  ( -- * Creating a Request
    DeleteDomainAssociation (..),
    newDeleteDomainAssociation,

    -- * Request Lenses
    deleteDomainAssociation_appId,
    deleteDomainAssociation_domainName,

    -- * Destructuring the Response
    DeleteDomainAssociationResponse (..),
    newDeleteDomainAssociationResponse,

    -- * Response Lenses
    deleteDomainAssociationResponse_httpStatus,
    deleteDomainAssociationResponse_domainAssociation,
  )
where

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

-- | The request structure for the delete domain association request.
--
-- /See:/ 'newDeleteDomainAssociation' smart constructor.
data DeleteDomainAssociation = DeleteDomainAssociation'
  { -- | The unique id for an Amplify app.
    DeleteDomainAssociation -> Text
appId :: Prelude.Text,
    -- | The name of the domain.
    DeleteDomainAssociation -> Text
domainName :: Prelude.Text
  }
  deriving (DeleteDomainAssociation -> DeleteDomainAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDomainAssociation -> DeleteDomainAssociation -> Bool
$c/= :: DeleteDomainAssociation -> DeleteDomainAssociation -> Bool
== :: DeleteDomainAssociation -> DeleteDomainAssociation -> Bool
$c== :: DeleteDomainAssociation -> DeleteDomainAssociation -> Bool
Prelude.Eq, ReadPrec [DeleteDomainAssociation]
ReadPrec DeleteDomainAssociation
Int -> ReadS DeleteDomainAssociation
ReadS [DeleteDomainAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDomainAssociation]
$creadListPrec :: ReadPrec [DeleteDomainAssociation]
readPrec :: ReadPrec DeleteDomainAssociation
$creadPrec :: ReadPrec DeleteDomainAssociation
readList :: ReadS [DeleteDomainAssociation]
$creadList :: ReadS [DeleteDomainAssociation]
readsPrec :: Int -> ReadS DeleteDomainAssociation
$creadsPrec :: Int -> ReadS DeleteDomainAssociation
Prelude.Read, Int -> DeleteDomainAssociation -> ShowS
[DeleteDomainAssociation] -> ShowS
DeleteDomainAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDomainAssociation] -> ShowS
$cshowList :: [DeleteDomainAssociation] -> ShowS
show :: DeleteDomainAssociation -> String
$cshow :: DeleteDomainAssociation -> String
showsPrec :: Int -> DeleteDomainAssociation -> ShowS
$cshowsPrec :: Int -> DeleteDomainAssociation -> ShowS
Prelude.Show, forall x. Rep DeleteDomainAssociation x -> DeleteDomainAssociation
forall x. DeleteDomainAssociation -> Rep DeleteDomainAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDomainAssociation x -> DeleteDomainAssociation
$cfrom :: forall x. DeleteDomainAssociation -> Rep DeleteDomainAssociation x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDomainAssociation' 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:
--
-- 'appId', 'deleteDomainAssociation_appId' - The unique id for an Amplify app.
--
-- 'domainName', 'deleteDomainAssociation_domainName' - The name of the domain.
newDeleteDomainAssociation ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  DeleteDomainAssociation
newDeleteDomainAssociation :: Text -> Text -> DeleteDomainAssociation
newDeleteDomainAssociation Text
pAppId_ Text
pDomainName_ =
  DeleteDomainAssociation'
    { $sel:appId:DeleteDomainAssociation' :: Text
appId = Text
pAppId_,
      $sel:domainName:DeleteDomainAssociation' :: Text
domainName = Text
pDomainName_
    }

-- | The unique id for an Amplify app.
deleteDomainAssociation_appId :: Lens.Lens' DeleteDomainAssociation Prelude.Text
deleteDomainAssociation_appId :: Lens' DeleteDomainAssociation Text
deleteDomainAssociation_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDomainAssociation' {Text
appId :: Text
$sel:appId:DeleteDomainAssociation' :: DeleteDomainAssociation -> Text
appId} -> Text
appId) (\s :: DeleteDomainAssociation
s@DeleteDomainAssociation' {} Text
a -> DeleteDomainAssociation
s {$sel:appId:DeleteDomainAssociation' :: Text
appId = Text
a} :: DeleteDomainAssociation)

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

instance Core.AWSRequest DeleteDomainAssociation where
  type
    AWSResponse DeleteDomainAssociation =
      DeleteDomainAssociationResponse
  request :: (Service -> Service)
-> DeleteDomainAssociation -> Request DeleteDomainAssociation
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 DeleteDomainAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteDomainAssociation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> DomainAssociation -> DeleteDomainAssociationResponse
DeleteDomainAssociationResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"domainAssociation")
      )

instance Prelude.Hashable DeleteDomainAssociation where
  hashWithSalt :: Int -> DeleteDomainAssociation -> Int
hashWithSalt Int
_salt DeleteDomainAssociation' {Text
domainName :: Text
appId :: Text
$sel:domainName:DeleteDomainAssociation' :: DeleteDomainAssociation -> Text
$sel:appId:DeleteDomainAssociation' :: DeleteDomainAssociation -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData DeleteDomainAssociation where
  rnf :: DeleteDomainAssociation -> ()
rnf DeleteDomainAssociation' {Text
domainName :: Text
appId :: Text
$sel:domainName:DeleteDomainAssociation' :: DeleteDomainAssociation -> Text
$sel:appId:DeleteDomainAssociation' :: DeleteDomainAssociation -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

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

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

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

-- |
-- Create a value of 'DeleteDomainAssociationResponse' 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', 'deleteDomainAssociationResponse_httpStatus' - The response's http status code.
--
-- 'domainAssociation', 'deleteDomainAssociationResponse_domainAssociation' - Undocumented member.
newDeleteDomainAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainAssociation'
  DomainAssociation ->
  DeleteDomainAssociationResponse
newDeleteDomainAssociationResponse :: Int -> DomainAssociation -> DeleteDomainAssociationResponse
newDeleteDomainAssociationResponse
  Int
pHttpStatus_
  DomainAssociation
pDomainAssociation_ =
    DeleteDomainAssociationResponse'
      { $sel:httpStatus:DeleteDomainAssociationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:domainAssociation:DeleteDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
pDomainAssociation_
      }

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

-- | Undocumented member.
deleteDomainAssociationResponse_domainAssociation :: Lens.Lens' DeleteDomainAssociationResponse DomainAssociation
deleteDomainAssociationResponse_domainAssociation :: Lens' DeleteDomainAssociationResponse DomainAssociation
deleteDomainAssociationResponse_domainAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDomainAssociationResponse' {DomainAssociation
domainAssociation :: DomainAssociation
$sel:domainAssociation:DeleteDomainAssociationResponse' :: DeleteDomainAssociationResponse -> DomainAssociation
domainAssociation} -> DomainAssociation
domainAssociation) (\s :: DeleteDomainAssociationResponse
s@DeleteDomainAssociationResponse' {} DomainAssociation
a -> DeleteDomainAssociationResponse
s {$sel:domainAssociation:DeleteDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
a} :: DeleteDomainAssociationResponse)

instance
  Prelude.NFData
    DeleteDomainAssociationResponse
  where
  rnf :: DeleteDomainAssociationResponse -> ()
rnf DeleteDomainAssociationResponse' {Int
DomainAssociation
domainAssociation :: DomainAssociation
httpStatus :: Int
$sel:domainAssociation:DeleteDomainAssociationResponse' :: DeleteDomainAssociationResponse -> DomainAssociation
$sel:httpStatus:DeleteDomainAssociationResponse' :: DeleteDomainAssociationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DomainAssociation
domainAssociation