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

    -- * Request Lenses
    getDomainAssociation_appId,
    getDomainAssociation_domainName,

    -- * Destructuring the Response
    GetDomainAssociationResponse (..),
    newGetDomainAssociationResponse,

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

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

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

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

instance Core.AWSRequest GetDomainAssociation where
  type
    AWSResponse GetDomainAssociation =
      GetDomainAssociationResponse
  request :: (Service -> Service)
-> GetDomainAssociation -> Request GetDomainAssociation
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetDomainAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDomainAssociation)))
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 -> GetDomainAssociationResponse
GetDomainAssociationResponse'
            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 GetDomainAssociation where
  hashWithSalt :: Int -> GetDomainAssociation -> Int
hashWithSalt Int
_salt GetDomainAssociation' {Text
domainName :: Text
appId :: Text
$sel:domainName:GetDomainAssociation' :: GetDomainAssociation -> Text
$sel:appId:GetDomainAssociation' :: GetDomainAssociation -> 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 GetDomainAssociation where
  rnf :: GetDomainAssociation -> ()
rnf GetDomainAssociation' {Text
domainName :: Text
appId :: Text
$sel:domainName:GetDomainAssociation' :: GetDomainAssociation -> Text
$sel:appId:GetDomainAssociation' :: GetDomainAssociation -> 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 GetDomainAssociation where
  toHeaders :: GetDomainAssociation -> 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 GetDomainAssociation where
  toPath :: GetDomainAssociation -> ByteString
toPath GetDomainAssociation' {Text
domainName :: Text
appId :: Text
$sel:domainName:GetDomainAssociation' :: GetDomainAssociation -> Text
$sel:appId:GetDomainAssociation' :: GetDomainAssociation -> 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 GetDomainAssociation where
  toQuery :: GetDomainAssociation -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | The result structure for the get domain association request.
--
-- /See:/ 'newGetDomainAssociationResponse' smart constructor.
data GetDomainAssociationResponse = GetDomainAssociationResponse'
  { -- | The response's http status code.
    GetDomainAssociationResponse -> Int
httpStatus :: Prelude.Int,
    -- | Describes the structure of a domain association, which associates a
    -- custom domain with an Amplify app.
    GetDomainAssociationResponse -> DomainAssociation
domainAssociation :: DomainAssociation
  }
  deriving (GetDomainAssociationResponse
-> GetDomainAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainAssociationResponse
-> GetDomainAssociationResponse -> Bool
$c/= :: GetDomainAssociationResponse
-> GetDomainAssociationResponse -> Bool
== :: GetDomainAssociationResponse
-> GetDomainAssociationResponse -> Bool
$c== :: GetDomainAssociationResponse
-> GetDomainAssociationResponse -> Bool
Prelude.Eq, ReadPrec [GetDomainAssociationResponse]
ReadPrec GetDomainAssociationResponse
Int -> ReadS GetDomainAssociationResponse
ReadS [GetDomainAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainAssociationResponse]
$creadListPrec :: ReadPrec [GetDomainAssociationResponse]
readPrec :: ReadPrec GetDomainAssociationResponse
$creadPrec :: ReadPrec GetDomainAssociationResponse
readList :: ReadS [GetDomainAssociationResponse]
$creadList :: ReadS [GetDomainAssociationResponse]
readsPrec :: Int -> ReadS GetDomainAssociationResponse
$creadsPrec :: Int -> ReadS GetDomainAssociationResponse
Prelude.Read, Int -> GetDomainAssociationResponse -> ShowS
[GetDomainAssociationResponse] -> ShowS
GetDomainAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainAssociationResponse] -> ShowS
$cshowList :: [GetDomainAssociationResponse] -> ShowS
show :: GetDomainAssociationResponse -> String
$cshow :: GetDomainAssociationResponse -> String
showsPrec :: Int -> GetDomainAssociationResponse -> ShowS
$cshowsPrec :: Int -> GetDomainAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep GetDomainAssociationResponse x -> GetDomainAssociationResponse
forall x.
GetDomainAssociationResponse -> Rep GetDomainAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDomainAssociationResponse x -> GetDomainAssociationResponse
$cfrom :: forall x.
GetDomainAssociationResponse -> Rep GetDomainAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainAssociationResponse' 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', 'getDomainAssociationResponse_httpStatus' - The response's http status code.
--
-- 'domainAssociation', 'getDomainAssociationResponse_domainAssociation' - Describes the structure of a domain association, which associates a
-- custom domain with an Amplify app.
newGetDomainAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainAssociation'
  DomainAssociation ->
  GetDomainAssociationResponse
newGetDomainAssociationResponse :: Int -> DomainAssociation -> GetDomainAssociationResponse
newGetDomainAssociationResponse
  Int
pHttpStatus_
  DomainAssociation
pDomainAssociation_ =
    GetDomainAssociationResponse'
      { $sel:httpStatus:GetDomainAssociationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:domainAssociation:GetDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
pDomainAssociation_
      }

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

-- | Describes the structure of a domain association, which associates a
-- custom domain with an Amplify app.
getDomainAssociationResponse_domainAssociation :: Lens.Lens' GetDomainAssociationResponse DomainAssociation
getDomainAssociationResponse_domainAssociation :: Lens' GetDomainAssociationResponse DomainAssociation
getDomainAssociationResponse_domainAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainAssociationResponse' {DomainAssociation
domainAssociation :: DomainAssociation
$sel:domainAssociation:GetDomainAssociationResponse' :: GetDomainAssociationResponse -> DomainAssociation
domainAssociation} -> DomainAssociation
domainAssociation) (\s :: GetDomainAssociationResponse
s@GetDomainAssociationResponse' {} DomainAssociation
a -> GetDomainAssociationResponse
s {$sel:domainAssociation:GetDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
a} :: GetDomainAssociationResponse)

instance Prelude.NFData GetDomainAssociationResponse where
  rnf :: GetDomainAssociationResponse -> ()
rnf GetDomainAssociationResponse' {Int
DomainAssociation
domainAssociation :: DomainAssociation
httpStatus :: Int
$sel:domainAssociation:GetDomainAssociationResponse' :: GetDomainAssociationResponse -> DomainAssociation
$sel:httpStatus:GetDomainAssociationResponse' :: GetDomainAssociationResponse -> 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