{-# 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.Transfer.UpdateCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the active and inactive dates for a certificate.
module Amazonka.Transfer.UpdateCertificate
  ( -- * Creating a Request
    UpdateCertificate (..),
    newUpdateCertificate,

    -- * Request Lenses
    updateCertificate_activeDate,
    updateCertificate_description,
    updateCertificate_inactiveDate,
    updateCertificate_certificateId,

    -- * Destructuring the Response
    UpdateCertificateResponse (..),
    newUpdateCertificateResponse,

    -- * Response Lenses
    updateCertificateResponse_httpStatus,
    updateCertificateResponse_certificateId,
  )
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.Transfer.Types

-- | /See:/ 'newUpdateCertificate' smart constructor.
data UpdateCertificate = UpdateCertificate'
  { -- | An optional date that specifies when the certificate becomes active.
    UpdateCertificate -> Maybe POSIX
activeDate :: Prelude.Maybe Data.POSIX,
    -- | A short description to help identify the certificate.
    UpdateCertificate -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An optional date that specifies when the certificate becomes inactive.
    UpdateCertificate -> Maybe POSIX
inactiveDate :: Prelude.Maybe Data.POSIX,
    -- | The identifier of the certificate object that you are updating.
    UpdateCertificate -> Text
certificateId :: Prelude.Text
  }
  deriving (UpdateCertificate -> UpdateCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCertificate -> UpdateCertificate -> Bool
$c/= :: UpdateCertificate -> UpdateCertificate -> Bool
== :: UpdateCertificate -> UpdateCertificate -> Bool
$c== :: UpdateCertificate -> UpdateCertificate -> Bool
Prelude.Eq, ReadPrec [UpdateCertificate]
ReadPrec UpdateCertificate
Int -> ReadS UpdateCertificate
ReadS [UpdateCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCertificate]
$creadListPrec :: ReadPrec [UpdateCertificate]
readPrec :: ReadPrec UpdateCertificate
$creadPrec :: ReadPrec UpdateCertificate
readList :: ReadS [UpdateCertificate]
$creadList :: ReadS [UpdateCertificate]
readsPrec :: Int -> ReadS UpdateCertificate
$creadsPrec :: Int -> ReadS UpdateCertificate
Prelude.Read, Int -> UpdateCertificate -> ShowS
[UpdateCertificate] -> ShowS
UpdateCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCertificate] -> ShowS
$cshowList :: [UpdateCertificate] -> ShowS
show :: UpdateCertificate -> String
$cshow :: UpdateCertificate -> String
showsPrec :: Int -> UpdateCertificate -> ShowS
$cshowsPrec :: Int -> UpdateCertificate -> ShowS
Prelude.Show, forall x. Rep UpdateCertificate x -> UpdateCertificate
forall x. UpdateCertificate -> Rep UpdateCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCertificate x -> UpdateCertificate
$cfrom :: forall x. UpdateCertificate -> Rep UpdateCertificate x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCertificate' 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:
--
-- 'activeDate', 'updateCertificate_activeDate' - An optional date that specifies when the certificate becomes active.
--
-- 'description', 'updateCertificate_description' - A short description to help identify the certificate.
--
-- 'inactiveDate', 'updateCertificate_inactiveDate' - An optional date that specifies when the certificate becomes inactive.
--
-- 'certificateId', 'updateCertificate_certificateId' - The identifier of the certificate object that you are updating.
newUpdateCertificate ::
  -- | 'certificateId'
  Prelude.Text ->
  UpdateCertificate
newUpdateCertificate :: Text -> UpdateCertificate
newUpdateCertificate Text
pCertificateId_ =
  UpdateCertificate'
    { $sel:activeDate:UpdateCertificate' :: Maybe POSIX
activeDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateCertificate' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:inactiveDate:UpdateCertificate' :: Maybe POSIX
inactiveDate = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateId:UpdateCertificate' :: Text
certificateId = Text
pCertificateId_
    }

-- | An optional date that specifies when the certificate becomes active.
updateCertificate_activeDate :: Lens.Lens' UpdateCertificate (Prelude.Maybe Prelude.UTCTime)
updateCertificate_activeDate :: Lens' UpdateCertificate (Maybe UTCTime)
updateCertificate_activeDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCertificate' {Maybe POSIX
activeDate :: Maybe POSIX
$sel:activeDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
activeDate} -> Maybe POSIX
activeDate) (\s :: UpdateCertificate
s@UpdateCertificate' {} Maybe POSIX
a -> UpdateCertificate
s {$sel:activeDate:UpdateCertificate' :: Maybe POSIX
activeDate = Maybe POSIX
a} :: UpdateCertificate) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A short description to help identify the certificate.
updateCertificate_description :: Lens.Lens' UpdateCertificate (Prelude.Maybe Prelude.Text)
updateCertificate_description :: Lens' UpdateCertificate (Maybe Text)
updateCertificate_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCertificate' {Maybe Text
description :: Maybe Text
$sel:description:UpdateCertificate' :: UpdateCertificate -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateCertificate
s@UpdateCertificate' {} Maybe Text
a -> UpdateCertificate
s {$sel:description:UpdateCertificate' :: Maybe Text
description = Maybe Text
a} :: UpdateCertificate)

-- | An optional date that specifies when the certificate becomes inactive.
updateCertificate_inactiveDate :: Lens.Lens' UpdateCertificate (Prelude.Maybe Prelude.UTCTime)
updateCertificate_inactiveDate :: Lens' UpdateCertificate (Maybe UTCTime)
updateCertificate_inactiveDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCertificate' {Maybe POSIX
inactiveDate :: Maybe POSIX
$sel:inactiveDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
inactiveDate} -> Maybe POSIX
inactiveDate) (\s :: UpdateCertificate
s@UpdateCertificate' {} Maybe POSIX
a -> UpdateCertificate
s {$sel:inactiveDate:UpdateCertificate' :: Maybe POSIX
inactiveDate = Maybe POSIX
a} :: UpdateCertificate) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The identifier of the certificate object that you are updating.
updateCertificate_certificateId :: Lens.Lens' UpdateCertificate Prelude.Text
updateCertificate_certificateId :: Lens' UpdateCertificate Text
updateCertificate_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCertificate' {Text
certificateId :: Text
$sel:certificateId:UpdateCertificate' :: UpdateCertificate -> Text
certificateId} -> Text
certificateId) (\s :: UpdateCertificate
s@UpdateCertificate' {} Text
a -> UpdateCertificate
s {$sel:certificateId:UpdateCertificate' :: Text
certificateId = Text
a} :: UpdateCertificate)

instance Core.AWSRequest UpdateCertificate where
  type
    AWSResponse UpdateCertificate =
      UpdateCertificateResponse
  request :: (Service -> Service)
-> UpdateCertificate -> Request UpdateCertificate
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 UpdateCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateCertificate)))
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 -> Text -> UpdateCertificateResponse
UpdateCertificateResponse'
            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
"CertificateId")
      )

instance Prelude.Hashable UpdateCertificate where
  hashWithSalt :: Int -> UpdateCertificate -> Int
hashWithSalt Int
_salt UpdateCertificate' {Maybe Text
Maybe POSIX
Text
certificateId :: Text
inactiveDate :: Maybe POSIX
description :: Maybe Text
activeDate :: Maybe POSIX
$sel:certificateId:UpdateCertificate' :: UpdateCertificate -> Text
$sel:inactiveDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
$sel:description:UpdateCertificate' :: UpdateCertificate -> Maybe Text
$sel:activeDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
activeDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
inactiveDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateId

instance Prelude.NFData UpdateCertificate where
  rnf :: UpdateCertificate -> ()
rnf UpdateCertificate' {Maybe Text
Maybe POSIX
Text
certificateId :: Text
inactiveDate :: Maybe POSIX
description :: Maybe Text
activeDate :: Maybe POSIX
$sel:certificateId:UpdateCertificate' :: UpdateCertificate -> Text
$sel:inactiveDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
$sel:description:UpdateCertificate' :: UpdateCertificate -> Maybe Text
$sel:activeDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
activeDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
inactiveDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificateId

instance Data.ToHeaders UpdateCertificate where
  toHeaders :: UpdateCertificate -> 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
"TransferService.UpdateCertificate" ::
                          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 UpdateCertificate where
  toJSON :: UpdateCertificate -> Value
toJSON UpdateCertificate' {Maybe Text
Maybe POSIX
Text
certificateId :: Text
inactiveDate :: Maybe POSIX
description :: Maybe Text
activeDate :: Maybe POSIX
$sel:certificateId:UpdateCertificate' :: UpdateCertificate -> Text
$sel:inactiveDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
$sel:description:UpdateCertificate' :: UpdateCertificate -> Maybe Text
$sel:activeDate:UpdateCertificate' :: UpdateCertificate -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ActiveDate" 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 POSIX
activeDate,
            (Key
"Description" 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
description,
            (Key
"InactiveDate" 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 POSIX
inactiveDate,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CertificateId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateId)
          ]
      )

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

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

-- | /See:/ 'newUpdateCertificateResponse' smart constructor.
data UpdateCertificateResponse = UpdateCertificateResponse'
  { -- | The response's http status code.
    UpdateCertificateResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns the identifier of the certificate object that you are updating.
    UpdateCertificateResponse -> Text
certificateId :: Prelude.Text
  }
  deriving (UpdateCertificateResponse -> UpdateCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCertificateResponse -> UpdateCertificateResponse -> Bool
$c/= :: UpdateCertificateResponse -> UpdateCertificateResponse -> Bool
== :: UpdateCertificateResponse -> UpdateCertificateResponse -> Bool
$c== :: UpdateCertificateResponse -> UpdateCertificateResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCertificateResponse]
ReadPrec UpdateCertificateResponse
Int -> ReadS UpdateCertificateResponse
ReadS [UpdateCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCertificateResponse]
$creadListPrec :: ReadPrec [UpdateCertificateResponse]
readPrec :: ReadPrec UpdateCertificateResponse
$creadPrec :: ReadPrec UpdateCertificateResponse
readList :: ReadS [UpdateCertificateResponse]
$creadList :: ReadS [UpdateCertificateResponse]
readsPrec :: Int -> ReadS UpdateCertificateResponse
$creadsPrec :: Int -> ReadS UpdateCertificateResponse
Prelude.Read, Int -> UpdateCertificateResponse -> ShowS
[UpdateCertificateResponse] -> ShowS
UpdateCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCertificateResponse] -> ShowS
$cshowList :: [UpdateCertificateResponse] -> ShowS
show :: UpdateCertificateResponse -> String
$cshow :: UpdateCertificateResponse -> String
showsPrec :: Int -> UpdateCertificateResponse -> ShowS
$cshowsPrec :: Int -> UpdateCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateCertificateResponse x -> UpdateCertificateResponse
forall x.
UpdateCertificateResponse -> Rep UpdateCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCertificateResponse x -> UpdateCertificateResponse
$cfrom :: forall x.
UpdateCertificateResponse -> Rep UpdateCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCertificateResponse' 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', 'updateCertificateResponse_httpStatus' - The response's http status code.
--
-- 'certificateId', 'updateCertificateResponse_certificateId' - Returns the identifier of the certificate object that you are updating.
newUpdateCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'certificateId'
  Prelude.Text ->
  UpdateCertificateResponse
newUpdateCertificateResponse :: Int -> Text -> UpdateCertificateResponse
newUpdateCertificateResponse
  Int
pHttpStatus_
  Text
pCertificateId_ =
    UpdateCertificateResponse'
      { $sel:httpStatus:UpdateCertificateResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:certificateId:UpdateCertificateResponse' :: Text
certificateId = Text
pCertificateId_
      }

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

-- | Returns the identifier of the certificate object that you are updating.
updateCertificateResponse_certificateId :: Lens.Lens' UpdateCertificateResponse Prelude.Text
updateCertificateResponse_certificateId :: Lens' UpdateCertificateResponse Text
updateCertificateResponse_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCertificateResponse' {Text
certificateId :: Text
$sel:certificateId:UpdateCertificateResponse' :: UpdateCertificateResponse -> Text
certificateId} -> Text
certificateId) (\s :: UpdateCertificateResponse
s@UpdateCertificateResponse' {} Text
a -> UpdateCertificateResponse
s {$sel:certificateId:UpdateCertificateResponse' :: Text
certificateId = Text
a} :: UpdateCertificateResponse)

instance Prelude.NFData UpdateCertificateResponse where
  rnf :: UpdateCertificateResponse -> ()
rnf UpdateCertificateResponse' {Int
Text
certificateId :: Text
httpStatus :: Int
$sel:certificateId:UpdateCertificateResponse' :: UpdateCertificateResponse -> Text
$sel:httpStatus:UpdateCertificateResponse' :: UpdateCertificateResponse -> 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 Text
certificateId