{-# 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.RenewDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation renews a domain for the specified number of years. The
-- cost of renewing your domain is billed to your Amazon Web Services
-- account.
--
-- We recommend that you renew your domain several weeks before the
-- expiration date. Some TLD registries delete domains before the
-- expiration date if you haven\'t renewed far enough in advance. For more
-- information about renewing domain registration, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/domain-renew.html Renewing Registration for a Domain>
-- in the /Amazon Route 53 Developer Guide/.
module Amazonka.Route53Domains.RenewDomain
  ( -- * Creating a Request
    RenewDomain (..),
    newRenewDomain,

    -- * Request Lenses
    renewDomain_durationInYears,
    renewDomain_domainName,
    renewDomain_currentExpiryYear,

    -- * Destructuring the Response
    RenewDomainResponse (..),
    newRenewDomainResponse,

    -- * Response Lenses
    renewDomainResponse_operationId,
    renewDomainResponse_httpStatus,
  )
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

-- | A @RenewDomain@ request includes the number of years that you want to
-- renew for and the current expiration year.
--
-- /See:/ 'newRenewDomain' smart constructor.
data RenewDomain = RenewDomain'
  { -- | The number of years that you want to renew the domain for. The maximum
    -- number of years depends on the top-level domain. For the range of valid
    -- values for your domain, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
    -- in the /Amazon Route 53 Developer Guide/.
    --
    -- Default: 1
    RenewDomain -> Maybe Natural
durationInYears :: Prelude.Maybe Prelude.Natural,
    -- | The name of the domain that you want to renew.
    RenewDomain -> Text
domainName :: Prelude.Text,
    -- | The year when the registration for the domain is set to expire. This
    -- value must match the current expiration date for the domain.
    RenewDomain -> Int
currentExpiryYear :: Prelude.Int
  }
  deriving (RenewDomain -> RenewDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenewDomain -> RenewDomain -> Bool
$c/= :: RenewDomain -> RenewDomain -> Bool
== :: RenewDomain -> RenewDomain -> Bool
$c== :: RenewDomain -> RenewDomain -> Bool
Prelude.Eq, ReadPrec [RenewDomain]
ReadPrec RenewDomain
Int -> ReadS RenewDomain
ReadS [RenewDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RenewDomain]
$creadListPrec :: ReadPrec [RenewDomain]
readPrec :: ReadPrec RenewDomain
$creadPrec :: ReadPrec RenewDomain
readList :: ReadS [RenewDomain]
$creadList :: ReadS [RenewDomain]
readsPrec :: Int -> ReadS RenewDomain
$creadsPrec :: Int -> ReadS RenewDomain
Prelude.Read, Int -> RenewDomain -> ShowS
[RenewDomain] -> ShowS
RenewDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenewDomain] -> ShowS
$cshowList :: [RenewDomain] -> ShowS
show :: RenewDomain -> String
$cshow :: RenewDomain -> String
showsPrec :: Int -> RenewDomain -> ShowS
$cshowsPrec :: Int -> RenewDomain -> ShowS
Prelude.Show, forall x. Rep RenewDomain x -> RenewDomain
forall x. RenewDomain -> Rep RenewDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenewDomain x -> RenewDomain
$cfrom :: forall x. RenewDomain -> Rep RenewDomain x
Prelude.Generic)

-- |
-- Create a value of 'RenewDomain' 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:
--
-- 'durationInYears', 'renewDomain_durationInYears' - The number of years that you want to renew the domain for. The maximum
-- number of years depends on the top-level domain. For the range of valid
-- values for your domain, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- Default: 1
--
-- 'domainName', 'renewDomain_domainName' - The name of the domain that you want to renew.
--
-- 'currentExpiryYear', 'renewDomain_currentExpiryYear' - The year when the registration for the domain is set to expire. This
-- value must match the current expiration date for the domain.
newRenewDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'currentExpiryYear'
  Prelude.Int ->
  RenewDomain
newRenewDomain :: Text -> Int -> RenewDomain
newRenewDomain Text
pDomainName_ Int
pCurrentExpiryYear_ =
  RenewDomain'
    { $sel:durationInYears:RenewDomain' :: Maybe Natural
durationInYears = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:RenewDomain' :: Text
domainName = Text
pDomainName_,
      $sel:currentExpiryYear:RenewDomain' :: Int
currentExpiryYear = Int
pCurrentExpiryYear_
    }

-- | The number of years that you want to renew the domain for. The maximum
-- number of years depends on the top-level domain. For the range of valid
-- values for your domain, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- Default: 1
renewDomain_durationInYears :: Lens.Lens' RenewDomain (Prelude.Maybe Prelude.Natural)
renewDomain_durationInYears :: Lens' RenewDomain (Maybe Natural)
renewDomain_durationInYears = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RenewDomain' {Maybe Natural
durationInYears :: Maybe Natural
$sel:durationInYears:RenewDomain' :: RenewDomain -> Maybe Natural
durationInYears} -> Maybe Natural
durationInYears) (\s :: RenewDomain
s@RenewDomain' {} Maybe Natural
a -> RenewDomain
s {$sel:durationInYears:RenewDomain' :: Maybe Natural
durationInYears = Maybe Natural
a} :: RenewDomain)

-- | The name of the domain that you want to renew.
renewDomain_domainName :: Lens.Lens' RenewDomain Prelude.Text
renewDomain_domainName :: Lens' RenewDomain Text
renewDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RenewDomain' {Text
domainName :: Text
$sel:domainName:RenewDomain' :: RenewDomain -> Text
domainName} -> Text
domainName) (\s :: RenewDomain
s@RenewDomain' {} Text
a -> RenewDomain
s {$sel:domainName:RenewDomain' :: Text
domainName = Text
a} :: RenewDomain)

-- | The year when the registration for the domain is set to expire. This
-- value must match the current expiration date for the domain.
renewDomain_currentExpiryYear :: Lens.Lens' RenewDomain Prelude.Int
renewDomain_currentExpiryYear :: Lens' RenewDomain Int
renewDomain_currentExpiryYear = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RenewDomain' {Int
currentExpiryYear :: Int
$sel:currentExpiryYear:RenewDomain' :: RenewDomain -> Int
currentExpiryYear} -> Int
currentExpiryYear) (\s :: RenewDomain
s@RenewDomain' {} Int
a -> RenewDomain
s {$sel:currentExpiryYear:RenewDomain' :: Int
currentExpiryYear = Int
a} :: RenewDomain)

instance Core.AWSRequest RenewDomain where
  type AWSResponse RenewDomain = RenewDomainResponse
  request :: (Service -> Service) -> RenewDomain -> Request RenewDomain
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 RenewDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RenewDomain)))
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 Text -> Int -> RenewDomainResponse
RenewDomainResponse'
            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
"OperationId")
            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 RenewDomain where
  hashWithSalt :: Int -> RenewDomain -> Int
hashWithSalt Int
_salt RenewDomain' {Int
Maybe Natural
Text
currentExpiryYear :: Int
domainName :: Text
durationInYears :: Maybe Natural
$sel:currentExpiryYear:RenewDomain' :: RenewDomain -> Int
$sel:domainName:RenewDomain' :: RenewDomain -> Text
$sel:durationInYears:RenewDomain' :: RenewDomain -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
durationInYears
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
currentExpiryYear

instance Prelude.NFData RenewDomain where
  rnf :: RenewDomain -> ()
rnf RenewDomain' {Int
Maybe Natural
Text
currentExpiryYear :: Int
domainName :: Text
durationInYears :: Maybe Natural
$sel:currentExpiryYear:RenewDomain' :: RenewDomain -> Int
$sel:domainName:RenewDomain' :: RenewDomain -> Text
$sel:durationInYears:RenewDomain' :: RenewDomain -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
durationInYears
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
currentExpiryYear

instance Data.ToHeaders RenewDomain where
  toHeaders :: RenewDomain -> 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
"Route53Domains_v20140515.RenewDomain" ::
                          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 RenewDomain where
  toJSON :: RenewDomain -> Value
toJSON RenewDomain' {Int
Maybe Natural
Text
currentExpiryYear :: Int
domainName :: Text
durationInYears :: Maybe Natural
$sel:currentExpiryYear:RenewDomain' :: RenewDomain -> Int
$sel:domainName:RenewDomain' :: RenewDomain -> Text
$sel:durationInYears:RenewDomain' :: RenewDomain -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DurationInYears" 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 Natural
durationInYears,
            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
"CurrentExpiryYear" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
currentExpiryYear)
          ]
      )

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

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

-- | /See:/ 'newRenewDomainResponse' smart constructor.
data RenewDomainResponse = RenewDomainResponse'
  { -- | Identifier for tracking the progress of the request. To query the
    -- operation status, use
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
    RenewDomainResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RenewDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RenewDomainResponse -> RenewDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenewDomainResponse -> RenewDomainResponse -> Bool
$c/= :: RenewDomainResponse -> RenewDomainResponse -> Bool
== :: RenewDomainResponse -> RenewDomainResponse -> Bool
$c== :: RenewDomainResponse -> RenewDomainResponse -> Bool
Prelude.Eq, ReadPrec [RenewDomainResponse]
ReadPrec RenewDomainResponse
Int -> ReadS RenewDomainResponse
ReadS [RenewDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RenewDomainResponse]
$creadListPrec :: ReadPrec [RenewDomainResponse]
readPrec :: ReadPrec RenewDomainResponse
$creadPrec :: ReadPrec RenewDomainResponse
readList :: ReadS [RenewDomainResponse]
$creadList :: ReadS [RenewDomainResponse]
readsPrec :: Int -> ReadS RenewDomainResponse
$creadsPrec :: Int -> ReadS RenewDomainResponse
Prelude.Read, Int -> RenewDomainResponse -> ShowS
[RenewDomainResponse] -> ShowS
RenewDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenewDomainResponse] -> ShowS
$cshowList :: [RenewDomainResponse] -> ShowS
show :: RenewDomainResponse -> String
$cshow :: RenewDomainResponse -> String
showsPrec :: Int -> RenewDomainResponse -> ShowS
$cshowsPrec :: Int -> RenewDomainResponse -> ShowS
Prelude.Show, forall x. Rep RenewDomainResponse x -> RenewDomainResponse
forall x. RenewDomainResponse -> Rep RenewDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenewDomainResponse x -> RenewDomainResponse
$cfrom :: forall x. RenewDomainResponse -> Rep RenewDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'RenewDomainResponse' 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:
--
-- 'operationId', 'renewDomainResponse_operationId' - Identifier for tracking the progress of the request. To query the
-- operation status, use
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
--
-- 'httpStatus', 'renewDomainResponse_httpStatus' - The response's http status code.
newRenewDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RenewDomainResponse
newRenewDomainResponse :: Int -> RenewDomainResponse
newRenewDomainResponse Int
pHttpStatus_ =
  RenewDomainResponse'
    { $sel:operationId:RenewDomainResponse' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RenewDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Identifier for tracking the progress of the request. To query the
-- operation status, use
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
renewDomainResponse_operationId :: Lens.Lens' RenewDomainResponse (Prelude.Maybe Prelude.Text)
renewDomainResponse_operationId :: Lens' RenewDomainResponse (Maybe Text)
renewDomainResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RenewDomainResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:RenewDomainResponse' :: RenewDomainResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: RenewDomainResponse
s@RenewDomainResponse' {} Maybe Text
a -> RenewDomainResponse
s {$sel:operationId:RenewDomainResponse' :: Maybe Text
operationId = Maybe Text
a} :: RenewDomainResponse)

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

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