{-# 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.Lightsail.GetDomain
-- 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 information about a specific domain recordset.
module Amazonka.Lightsail.GetDomain
  ( -- * Creating a Request
    GetDomain (..),
    newGetDomain,

    -- * Request Lenses
    getDomain_domainName,

    -- * Destructuring the Response
    GetDomainResponse (..),
    newGetDomainResponse,

    -- * Response Lenses
    getDomainResponse_domain,
    getDomainResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetDomain' smart constructor.
data GetDomain = GetDomain'
  { -- | The domain name for which your want to return information about.
    GetDomain -> Text
domainName :: Prelude.Text
  }
  deriving (GetDomain -> GetDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomain -> GetDomain -> Bool
$c/= :: GetDomain -> GetDomain -> Bool
== :: GetDomain -> GetDomain -> Bool
$c== :: GetDomain -> GetDomain -> Bool
Prelude.Eq, ReadPrec [GetDomain]
ReadPrec GetDomain
Int -> ReadS GetDomain
ReadS [GetDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomain]
$creadListPrec :: ReadPrec [GetDomain]
readPrec :: ReadPrec GetDomain
$creadPrec :: ReadPrec GetDomain
readList :: ReadS [GetDomain]
$creadList :: ReadS [GetDomain]
readsPrec :: Int -> ReadS GetDomain
$creadsPrec :: Int -> ReadS GetDomain
Prelude.Read, Int -> GetDomain -> ShowS
[GetDomain] -> ShowS
GetDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomain] -> ShowS
$cshowList :: [GetDomain] -> ShowS
show :: GetDomain -> String
$cshow :: GetDomain -> String
showsPrec :: Int -> GetDomain -> ShowS
$cshowsPrec :: Int -> GetDomain -> ShowS
Prelude.Show, forall x. Rep GetDomain x -> GetDomain
forall x. GetDomain -> Rep GetDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomain x -> GetDomain
$cfrom :: forall x. GetDomain -> Rep GetDomain x
Prelude.Generic)

-- |
-- Create a value of 'GetDomain' 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', 'getDomain_domainName' - The domain name for which your want to return information about.
newGetDomain ::
  -- | 'domainName'
  Prelude.Text ->
  GetDomain
newGetDomain :: Text -> GetDomain
newGetDomain Text
pDomainName_ =
  GetDomain' {$sel:domainName:GetDomain' :: Text
domainName = Text
pDomainName_}

-- | The domain name for which your want to return information about.
getDomain_domainName :: Lens.Lens' GetDomain Prelude.Text
getDomain_domainName :: Lens' GetDomain Text
getDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomain' {Text
domainName :: Text
$sel:domainName:GetDomain' :: GetDomain -> Text
domainName} -> Text
domainName) (\s :: GetDomain
s@GetDomain' {} Text
a -> GetDomain
s {$sel:domainName:GetDomain' :: Text
domainName = Text
a} :: GetDomain)

instance Core.AWSRequest GetDomain where
  type AWSResponse GetDomain = GetDomainResponse
  request :: (Service -> Service) -> GetDomain -> Request GetDomain
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 GetDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDomain)))
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 ->
          Maybe Domain -> Int -> GetDomainResponse
GetDomainResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"domain")
            forall (f :: * -> *) a b. Applicative f => 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 GetDomain where
  hashWithSalt :: Int -> GetDomain -> Int
hashWithSalt Int
_salt GetDomain' {Text
domainName :: Text
$sel:domainName:GetDomain' :: GetDomain -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

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

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

instance Data.ToJSON GetDomain where
  toJSON :: GetDomain -> Value
toJSON GetDomain' {Text
domainName :: Text
$sel:domainName:GetDomain' :: GetDomain -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"domainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)]
      )

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

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

-- | /See:/ 'newGetDomainResponse' smart constructor.
data GetDomainResponse = GetDomainResponse'
  { -- | An array of key-value pairs containing information about your get domain
    -- request.
    GetDomainResponse -> Maybe Domain
domain :: Prelude.Maybe Domain,
    -- | The response's http status code.
    GetDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDomainResponse -> GetDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainResponse -> GetDomainResponse -> Bool
$c/= :: GetDomainResponse -> GetDomainResponse -> Bool
== :: GetDomainResponse -> GetDomainResponse -> Bool
$c== :: GetDomainResponse -> GetDomainResponse -> Bool
Prelude.Eq, ReadPrec [GetDomainResponse]
ReadPrec GetDomainResponse
Int -> ReadS GetDomainResponse
ReadS [GetDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainResponse]
$creadListPrec :: ReadPrec [GetDomainResponse]
readPrec :: ReadPrec GetDomainResponse
$creadPrec :: ReadPrec GetDomainResponse
readList :: ReadS [GetDomainResponse]
$creadList :: ReadS [GetDomainResponse]
readsPrec :: Int -> ReadS GetDomainResponse
$creadsPrec :: Int -> ReadS GetDomainResponse
Prelude.Read, Int -> GetDomainResponse -> ShowS
[GetDomainResponse] -> ShowS
GetDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainResponse] -> ShowS
$cshowList :: [GetDomainResponse] -> ShowS
show :: GetDomainResponse -> String
$cshow :: GetDomainResponse -> String
showsPrec :: Int -> GetDomainResponse -> ShowS
$cshowsPrec :: Int -> GetDomainResponse -> ShowS
Prelude.Show, forall x. Rep GetDomainResponse x -> GetDomainResponse
forall x. GetDomainResponse -> Rep GetDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainResponse x -> GetDomainResponse
$cfrom :: forall x. GetDomainResponse -> Rep GetDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainResponse' 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:
--
-- 'domain', 'getDomainResponse_domain' - An array of key-value pairs containing information about your get domain
-- request.
--
-- 'httpStatus', 'getDomainResponse_httpStatus' - The response's http status code.
newGetDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDomainResponse
newGetDomainResponse :: Int -> GetDomainResponse
newGetDomainResponse Int
pHttpStatus_ =
  GetDomainResponse'
    { $sel:domain:GetDomainResponse' :: Maybe Domain
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of key-value pairs containing information about your get domain
-- request.
getDomainResponse_domain :: Lens.Lens' GetDomainResponse (Prelude.Maybe Domain)
getDomainResponse_domain :: Lens' GetDomainResponse (Maybe Domain)
getDomainResponse_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe Domain
domain :: Maybe Domain
$sel:domain:GetDomainResponse' :: GetDomainResponse -> Maybe Domain
domain} -> Maybe Domain
domain) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe Domain
a -> GetDomainResponse
s {$sel:domain:GetDomainResponse' :: Maybe Domain
domain = Maybe Domain
a} :: GetDomainResponse)

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

instance Prelude.NFData GetDomainResponse where
  rnf :: GetDomainResponse -> ()
rnf GetDomainResponse' {Int
Maybe Domain
httpStatus :: Int
domain :: Maybe Domain
$sel:httpStatus:GetDomainResponse' :: GetDomainResponse -> Int
$sel:domain:GetDomainResponse' :: GetDomainResponse -> Maybe Domain
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Domain
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus