{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.DomainEntry
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Lightsail.Types.DomainEntry where

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

-- | Describes a domain recordset entry.
--
-- /See:/ 'newDomainEntry' smart constructor.
data DomainEntry = DomainEntry'
  { -- | The ID of the domain recordset entry.
    DomainEntry -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | When @true@, specifies whether the domain entry is an alias used by the
    -- Lightsail load balancer. You can include an alias (A type) record in
    -- your request, which points to a load balancer DNS name and routes
    -- traffic to your load balancer.
    DomainEntry -> Maybe Bool
isAlias :: Prelude.Maybe Prelude.Bool,
    -- | The name of the domain.
    DomainEntry -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | (Deprecated) The options for the domain entry.
    --
    -- In releases prior to November 29, 2017, this parameter was not included
    -- in the API response. It is now deprecated.
    DomainEntry -> Maybe (HashMap Text Text)
options :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The target IP address (e.g., @192.0.2.0@), or AWS name server (e.g.,
    -- @ns-111.awsdns-22.com.@).
    --
    -- For Lightsail load balancers, the value looks like
    -- @ab1234c56789c6b86aba6fb203d443bc-123456789.us-east-2.elb.amazonaws.com@.
    -- For Lightsail distributions, the value looks like
    -- @exampled1182ne.cloudfront.net@. For Lightsail container services, the
    -- value looks like
    -- @container-service-1.example23scljs.us-west-2.cs.amazonlightsail.com@.
    -- Be sure to also set @isAlias@ to @true@ when setting up an A record for
    -- a Lightsail load balancer, distribution, or container service.
    DomainEntry -> Maybe Text
target :: Prelude.Maybe Prelude.Text,
    -- | The type of domain entry, such as address for IPv4 (A), address for IPv6
    -- (AAAA), canonical name (CNAME), mail exchanger (MX), name server (NS),
    -- start of authority (SOA), service locator (SRV), or text (TXT).
    --
    -- The following domain entry types can be used:
    --
    -- -   @A@
    --
    -- -   @AAAA@
    --
    -- -   @CNAME@
    --
    -- -   @MX@
    --
    -- -   @NS@
    --
    -- -   @SOA@
    --
    -- -   @SRV@
    --
    -- -   @TXT@
    DomainEntry -> Maybe Text
type' :: Prelude.Maybe Prelude.Text
  }
  deriving (DomainEntry -> DomainEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainEntry -> DomainEntry -> Bool
$c/= :: DomainEntry -> DomainEntry -> Bool
== :: DomainEntry -> DomainEntry -> Bool
$c== :: DomainEntry -> DomainEntry -> Bool
Prelude.Eq, ReadPrec [DomainEntry]
ReadPrec DomainEntry
Int -> ReadS DomainEntry
ReadS [DomainEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DomainEntry]
$creadListPrec :: ReadPrec [DomainEntry]
readPrec :: ReadPrec DomainEntry
$creadPrec :: ReadPrec DomainEntry
readList :: ReadS [DomainEntry]
$creadList :: ReadS [DomainEntry]
readsPrec :: Int -> ReadS DomainEntry
$creadsPrec :: Int -> ReadS DomainEntry
Prelude.Read, Int -> DomainEntry -> ShowS
[DomainEntry] -> ShowS
DomainEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainEntry] -> ShowS
$cshowList :: [DomainEntry] -> ShowS
show :: DomainEntry -> String
$cshow :: DomainEntry -> String
showsPrec :: Int -> DomainEntry -> ShowS
$cshowsPrec :: Int -> DomainEntry -> ShowS
Prelude.Show, forall x. Rep DomainEntry x -> DomainEntry
forall x. DomainEntry -> Rep DomainEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DomainEntry x -> DomainEntry
$cfrom :: forall x. DomainEntry -> Rep DomainEntry x
Prelude.Generic)

-- |
-- Create a value of 'DomainEntry' 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:
--
-- 'id', 'domainEntry_id' - The ID of the domain recordset entry.
--
-- 'isAlias', 'domainEntry_isAlias' - When @true@, specifies whether the domain entry is an alias used by the
-- Lightsail load balancer. You can include an alias (A type) record in
-- your request, which points to a load balancer DNS name and routes
-- traffic to your load balancer.
--
-- 'name', 'domainEntry_name' - The name of the domain.
--
-- 'options', 'domainEntry_options' - (Deprecated) The options for the domain entry.
--
-- In releases prior to November 29, 2017, this parameter was not included
-- in the API response. It is now deprecated.
--
-- 'target', 'domainEntry_target' - The target IP address (e.g., @192.0.2.0@), or AWS name server (e.g.,
-- @ns-111.awsdns-22.com.@).
--
-- For Lightsail load balancers, the value looks like
-- @ab1234c56789c6b86aba6fb203d443bc-123456789.us-east-2.elb.amazonaws.com@.
-- For Lightsail distributions, the value looks like
-- @exampled1182ne.cloudfront.net@. For Lightsail container services, the
-- value looks like
-- @container-service-1.example23scljs.us-west-2.cs.amazonlightsail.com@.
-- Be sure to also set @isAlias@ to @true@ when setting up an A record for
-- a Lightsail load balancer, distribution, or container service.
--
-- 'type'', 'domainEntry_type' - The type of domain entry, such as address for IPv4 (A), address for IPv6
-- (AAAA), canonical name (CNAME), mail exchanger (MX), name server (NS),
-- start of authority (SOA), service locator (SRV), or text (TXT).
--
-- The following domain entry types can be used:
--
-- -   @A@
--
-- -   @AAAA@
--
-- -   @CNAME@
--
-- -   @MX@
--
-- -   @NS@
--
-- -   @SOA@
--
-- -   @SRV@
--
-- -   @TXT@
newDomainEntry ::
  DomainEntry
newDomainEntry :: DomainEntry
newDomainEntry =
  DomainEntry'
    { $sel:id:DomainEntry' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:isAlias:DomainEntry' :: Maybe Bool
isAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DomainEntry' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:options:DomainEntry' :: Maybe (HashMap Text Text)
options = forall a. Maybe a
Prelude.Nothing,
      $sel:target:DomainEntry' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing,
      $sel:type':DomainEntry' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the domain recordset entry.
domainEntry_id :: Lens.Lens' DomainEntry (Prelude.Maybe Prelude.Text)
domainEntry_id :: Lens' DomainEntry (Maybe Text)
domainEntry_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainEntry' {Maybe Text
id :: Maybe Text
$sel:id:DomainEntry' :: DomainEntry -> Maybe Text
id} -> Maybe Text
id) (\s :: DomainEntry
s@DomainEntry' {} Maybe Text
a -> DomainEntry
s {$sel:id:DomainEntry' :: Maybe Text
id = Maybe Text
a} :: DomainEntry)

-- | When @true@, specifies whether the domain entry is an alias used by the
-- Lightsail load balancer. You can include an alias (A type) record in
-- your request, which points to a load balancer DNS name and routes
-- traffic to your load balancer.
domainEntry_isAlias :: Lens.Lens' DomainEntry (Prelude.Maybe Prelude.Bool)
domainEntry_isAlias :: Lens' DomainEntry (Maybe Bool)
domainEntry_isAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainEntry' {Maybe Bool
isAlias :: Maybe Bool
$sel:isAlias:DomainEntry' :: DomainEntry -> Maybe Bool
isAlias} -> Maybe Bool
isAlias) (\s :: DomainEntry
s@DomainEntry' {} Maybe Bool
a -> DomainEntry
s {$sel:isAlias:DomainEntry' :: Maybe Bool
isAlias = Maybe Bool
a} :: DomainEntry)

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

-- | (Deprecated) The options for the domain entry.
--
-- In releases prior to November 29, 2017, this parameter was not included
-- in the API response. It is now deprecated.
domainEntry_options :: Lens.Lens' DomainEntry (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
domainEntry_options :: Lens' DomainEntry (Maybe (HashMap Text Text))
domainEntry_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainEntry' {Maybe (HashMap Text Text)
options :: Maybe (HashMap Text Text)
$sel:options:DomainEntry' :: DomainEntry -> Maybe (HashMap Text Text)
options} -> Maybe (HashMap Text Text)
options) (\s :: DomainEntry
s@DomainEntry' {} Maybe (HashMap Text Text)
a -> DomainEntry
s {$sel:options:DomainEntry' :: Maybe (HashMap Text Text)
options = Maybe (HashMap Text Text)
a} :: DomainEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The target IP address (e.g., @192.0.2.0@), or AWS name server (e.g.,
-- @ns-111.awsdns-22.com.@).
--
-- For Lightsail load balancers, the value looks like
-- @ab1234c56789c6b86aba6fb203d443bc-123456789.us-east-2.elb.amazonaws.com@.
-- For Lightsail distributions, the value looks like
-- @exampled1182ne.cloudfront.net@. For Lightsail container services, the
-- value looks like
-- @container-service-1.example23scljs.us-west-2.cs.amazonlightsail.com@.
-- Be sure to also set @isAlias@ to @true@ when setting up an A record for
-- a Lightsail load balancer, distribution, or container service.
domainEntry_target :: Lens.Lens' DomainEntry (Prelude.Maybe Prelude.Text)
domainEntry_target :: Lens' DomainEntry (Maybe Text)
domainEntry_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainEntry' {Maybe Text
target :: Maybe Text
$sel:target:DomainEntry' :: DomainEntry -> Maybe Text
target} -> Maybe Text
target) (\s :: DomainEntry
s@DomainEntry' {} Maybe Text
a -> DomainEntry
s {$sel:target:DomainEntry' :: Maybe Text
target = Maybe Text
a} :: DomainEntry)

-- | The type of domain entry, such as address for IPv4 (A), address for IPv6
-- (AAAA), canonical name (CNAME), mail exchanger (MX), name server (NS),
-- start of authority (SOA), service locator (SRV), or text (TXT).
--
-- The following domain entry types can be used:
--
-- -   @A@
--
-- -   @AAAA@
--
-- -   @CNAME@
--
-- -   @MX@
--
-- -   @NS@
--
-- -   @SOA@
--
-- -   @SRV@
--
-- -   @TXT@
domainEntry_type :: Lens.Lens' DomainEntry (Prelude.Maybe Prelude.Text)
domainEntry_type :: Lens' DomainEntry (Maybe Text)
domainEntry_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainEntry' {Maybe Text
type' :: Maybe Text
$sel:type':DomainEntry' :: DomainEntry -> Maybe Text
type'} -> Maybe Text
type') (\s :: DomainEntry
s@DomainEntry' {} Maybe Text
a -> DomainEntry
s {$sel:type':DomainEntry' :: Maybe Text
type' = Maybe Text
a} :: DomainEntry)

instance Data.FromJSON DomainEntry where
  parseJSON :: Value -> Parser DomainEntry
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DomainEntry"
      ( \Object
x ->
          Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> DomainEntry
DomainEntry'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"isAlias")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"options" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"target")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"type")
      )

instance Prelude.Hashable DomainEntry where
  hashWithSalt :: Int -> DomainEntry -> Int
hashWithSalt Int
_salt DomainEntry' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
type' :: Maybe Text
target :: Maybe Text
options :: Maybe (HashMap Text Text)
name :: Maybe Text
isAlias :: Maybe Bool
id :: Maybe Text
$sel:type':DomainEntry' :: DomainEntry -> Maybe Text
$sel:target:DomainEntry' :: DomainEntry -> Maybe Text
$sel:options:DomainEntry' :: DomainEntry -> Maybe (HashMap Text Text)
$sel:name:DomainEntry' :: DomainEntry -> Maybe Text
$sel:isAlias:DomainEntry' :: DomainEntry -> Maybe Bool
$sel:id:DomainEntry' :: DomainEntry -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
target
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
type'

instance Prelude.NFData DomainEntry where
  rnf :: DomainEntry -> ()
rnf DomainEntry' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
type' :: Maybe Text
target :: Maybe Text
options :: Maybe (HashMap Text Text)
name :: Maybe Text
isAlias :: Maybe Bool
id :: Maybe Text
$sel:type':DomainEntry' :: DomainEntry -> Maybe Text
$sel:target:DomainEntry' :: DomainEntry -> Maybe Text
$sel:options:DomainEntry' :: DomainEntry -> Maybe (HashMap Text Text)
$sel:name:DomainEntry' :: DomainEntry -> Maybe Text
$sel:isAlias:DomainEntry' :: DomainEntry -> Maybe Bool
$sel:id:DomainEntry' :: DomainEntry -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
type'

instance Data.ToJSON DomainEntry where
  toJSON :: DomainEntry -> Value
toJSON DomainEntry' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
type' :: Maybe Text
target :: Maybe Text
options :: Maybe (HashMap Text Text)
name :: Maybe Text
isAlias :: Maybe Bool
id :: Maybe Text
$sel:type':DomainEntry' :: DomainEntry -> Maybe Text
$sel:target:DomainEntry' :: DomainEntry -> Maybe Text
$sel:options:DomainEntry' :: DomainEntry -> Maybe (HashMap Text Text)
$sel:name:DomainEntry' :: DomainEntry -> Maybe Text
$sel:isAlias:DomainEntry' :: DomainEntry -> Maybe Bool
$sel:id:DomainEntry' :: DomainEntry -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"id" 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 Text
id,
            (Key
"isAlias" 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
isAlias,
            (Key
"name" 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 Text
name,
            (Key
"options" 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 (HashMap Text Text)
options,
            (Key
"target" 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 Text
target,
            (Key
"type" 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 Text
type'
          ]
      )