{-# 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.Route53Domains.PushDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Moves a domain from Amazon Web Services to another registrar.
--
-- Supported actions:
--
-- -   Changes the IPS tags of a .uk domain, and pushes it to transit.
--     Transit means that the domain is ready to be transferred to another
--     registrar.
module Amazonka.Route53Domains.PushDomain
  ( -- * Creating a Request
    PushDomain (..),
    newPushDomain,

    -- * Request Lenses
    pushDomain_domainName,
    pushDomain_target,

    -- * Destructuring the Response
    PushDomainResponse (..),
    newPushDomainResponse,
  )
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53Domains.Types

-- | /See:/ 'newPushDomain' smart constructor.
data PushDomain = PushDomain'
  { -- | Name of the domain.
    PushDomain -> Text
domainName :: Prelude.Text,
    -- | New IPS tag for the domain.
    PushDomain -> Text
target :: Prelude.Text
  }
  deriving (PushDomain -> PushDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushDomain -> PushDomain -> Bool
$c/= :: PushDomain -> PushDomain -> Bool
== :: PushDomain -> PushDomain -> Bool
$c== :: PushDomain -> PushDomain -> Bool
Prelude.Eq, ReadPrec [PushDomain]
ReadPrec PushDomain
Int -> ReadS PushDomain
ReadS [PushDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PushDomain]
$creadListPrec :: ReadPrec [PushDomain]
readPrec :: ReadPrec PushDomain
$creadPrec :: ReadPrec PushDomain
readList :: ReadS [PushDomain]
$creadList :: ReadS [PushDomain]
readsPrec :: Int -> ReadS PushDomain
$creadsPrec :: Int -> ReadS PushDomain
Prelude.Read, Int -> PushDomain -> ShowS
[PushDomain] -> ShowS
PushDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushDomain] -> ShowS
$cshowList :: [PushDomain] -> ShowS
show :: PushDomain -> String
$cshow :: PushDomain -> String
showsPrec :: Int -> PushDomain -> ShowS
$cshowsPrec :: Int -> PushDomain -> ShowS
Prelude.Show, forall x. Rep PushDomain x -> PushDomain
forall x. PushDomain -> Rep PushDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PushDomain x -> PushDomain
$cfrom :: forall x. PushDomain -> Rep PushDomain x
Prelude.Generic)

-- |
-- Create a value of 'PushDomain' 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', 'pushDomain_domainName' - Name of the domain.
--
-- 'target', 'pushDomain_target' - New IPS tag for the domain.
newPushDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'target'
  Prelude.Text ->
  PushDomain
newPushDomain :: Text -> Text -> PushDomain
newPushDomain Text
pDomainName_ Text
pTarget_ =
  PushDomain'
    { $sel:domainName:PushDomain' :: Text
domainName = Text
pDomainName_,
      $sel:target:PushDomain' :: Text
target = Text
pTarget_
    }

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

-- | New IPS tag for the domain.
pushDomain_target :: Lens.Lens' PushDomain Prelude.Text
pushDomain_target :: Lens' PushDomain Text
pushDomain_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PushDomain' {Text
target :: Text
$sel:target:PushDomain' :: PushDomain -> Text
target} -> Text
target) (\s :: PushDomain
s@PushDomain' {} Text
a -> PushDomain
s {$sel:target:PushDomain' :: Text
target = Text
a} :: PushDomain)

instance Core.AWSRequest PushDomain where
  type AWSResponse PushDomain = PushDomainResponse
  request :: (Service -> Service) -> PushDomain -> Request PushDomain
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 PushDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PushDomain)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PushDomainResponse
PushDomainResponse'

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

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

instance Data.ToHeaders PushDomain where
  toHeaders :: PushDomain -> [Header]
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 -> [Header]
Data.=# ( ByteString
"Route53Domains_v20140515.PushDomain" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PushDomain where
  toJSON :: PushDomain -> Value
toJSON PushDomain' {Text
target :: Text
domainName :: Text
$sel:target:PushDomain' :: PushDomain -> Text
$sel:domainName:PushDomain' :: PushDomain -> 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),
            forall a. a -> Maybe a
Prelude.Just (Key
"Target" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
target)
          ]
      )

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

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

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

-- |
-- Create a value of 'PushDomainResponse' 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.
newPushDomainResponse ::
  PushDomainResponse
newPushDomainResponse :: PushDomainResponse
newPushDomainResponse = PushDomainResponse
PushDomainResponse'

instance Prelude.NFData PushDomainResponse where
  rnf :: PushDomainResponse -> ()
rnf PushDomainResponse
_ = ()