{-# 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.GetCertificates
-- 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 one or more Amazon Lightsail SSL\/TLS
-- certificates.
--
-- To get a summary of a certificate, ommit @includeCertificateDetails@
-- from your request. The response will include only the certificate Amazon
-- Resource Name (ARN), certificate name, domain name, and tags.
module Amazonka.Lightsail.GetCertificates
  ( -- * Creating a Request
    GetCertificates (..),
    newGetCertificates,

    -- * Request Lenses
    getCertificates_certificateName,
    getCertificates_certificateStatuses,
    getCertificates_includeCertificateDetails,

    -- * Destructuring the Response
    GetCertificatesResponse (..),
    newGetCertificatesResponse,

    -- * Response Lenses
    getCertificatesResponse_certificates,
    getCertificatesResponse_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:/ 'newGetCertificates' smart constructor.
data GetCertificates = GetCertificates'
  { -- | The name for the certificate for which to return information.
    --
    -- When omitted, the response includes all of your certificates in the
    -- Amazon Web Services Region where the request is made.
    GetCertificates -> Maybe Text
certificateName :: Prelude.Maybe Prelude.Text,
    -- | The status of the certificates for which to return information.
    --
    -- For example, specify @ISSUED@ to return only certificates with an
    -- @ISSUED@ status.
    --
    -- When omitted, the response includes all of your certificates in the
    -- Amazon Web Services Region where the request is made, regardless of
    -- their current status.
    GetCertificates -> Maybe [CertificateStatus]
certificateStatuses :: Prelude.Maybe [CertificateStatus],
    -- | Indicates whether to include detailed information about the certificates
    -- in the response.
    --
    -- When omitted, the response includes only the certificate names, Amazon
    -- Resource Names (ARNs), domain names, and tags.
    GetCertificates -> Maybe Bool
includeCertificateDetails :: Prelude.Maybe Prelude.Bool
  }
  deriving (GetCertificates -> GetCertificates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCertificates -> GetCertificates -> Bool
$c/= :: GetCertificates -> GetCertificates -> Bool
== :: GetCertificates -> GetCertificates -> Bool
$c== :: GetCertificates -> GetCertificates -> Bool
Prelude.Eq, ReadPrec [GetCertificates]
ReadPrec GetCertificates
Int -> ReadS GetCertificates
ReadS [GetCertificates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCertificates]
$creadListPrec :: ReadPrec [GetCertificates]
readPrec :: ReadPrec GetCertificates
$creadPrec :: ReadPrec GetCertificates
readList :: ReadS [GetCertificates]
$creadList :: ReadS [GetCertificates]
readsPrec :: Int -> ReadS GetCertificates
$creadsPrec :: Int -> ReadS GetCertificates
Prelude.Read, Int -> GetCertificates -> ShowS
[GetCertificates] -> ShowS
GetCertificates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCertificates] -> ShowS
$cshowList :: [GetCertificates] -> ShowS
show :: GetCertificates -> String
$cshow :: GetCertificates -> String
showsPrec :: Int -> GetCertificates -> ShowS
$cshowsPrec :: Int -> GetCertificates -> ShowS
Prelude.Show, forall x. Rep GetCertificates x -> GetCertificates
forall x. GetCertificates -> Rep GetCertificates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCertificates x -> GetCertificates
$cfrom :: forall x. GetCertificates -> Rep GetCertificates x
Prelude.Generic)

-- |
-- Create a value of 'GetCertificates' 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:
--
-- 'certificateName', 'getCertificates_certificateName' - The name for the certificate for which to return information.
--
-- When omitted, the response includes all of your certificates in the
-- Amazon Web Services Region where the request is made.
--
-- 'certificateStatuses', 'getCertificates_certificateStatuses' - The status of the certificates for which to return information.
--
-- For example, specify @ISSUED@ to return only certificates with an
-- @ISSUED@ status.
--
-- When omitted, the response includes all of your certificates in the
-- Amazon Web Services Region where the request is made, regardless of
-- their current status.
--
-- 'includeCertificateDetails', 'getCertificates_includeCertificateDetails' - Indicates whether to include detailed information about the certificates
-- in the response.
--
-- When omitted, the response includes only the certificate names, Amazon
-- Resource Names (ARNs), domain names, and tags.
newGetCertificates ::
  GetCertificates
newGetCertificates :: GetCertificates
newGetCertificates =
  GetCertificates'
    { $sel:certificateName:GetCertificates' :: Maybe Text
certificateName = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateStatuses:GetCertificates' :: Maybe [CertificateStatus]
certificateStatuses = forall a. Maybe a
Prelude.Nothing,
      $sel:includeCertificateDetails:GetCertificates' :: Maybe Bool
includeCertificateDetails = forall a. Maybe a
Prelude.Nothing
    }

-- | The name for the certificate for which to return information.
--
-- When omitted, the response includes all of your certificates in the
-- Amazon Web Services Region where the request is made.
getCertificates_certificateName :: Lens.Lens' GetCertificates (Prelude.Maybe Prelude.Text)
getCertificates_certificateName :: Lens' GetCertificates (Maybe Text)
getCertificates_certificateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificates' {Maybe Text
certificateName :: Maybe Text
$sel:certificateName:GetCertificates' :: GetCertificates -> Maybe Text
certificateName} -> Maybe Text
certificateName) (\s :: GetCertificates
s@GetCertificates' {} Maybe Text
a -> GetCertificates
s {$sel:certificateName:GetCertificates' :: Maybe Text
certificateName = Maybe Text
a} :: GetCertificates)

-- | The status of the certificates for which to return information.
--
-- For example, specify @ISSUED@ to return only certificates with an
-- @ISSUED@ status.
--
-- When omitted, the response includes all of your certificates in the
-- Amazon Web Services Region where the request is made, regardless of
-- their current status.
getCertificates_certificateStatuses :: Lens.Lens' GetCertificates (Prelude.Maybe [CertificateStatus])
getCertificates_certificateStatuses :: Lens' GetCertificates (Maybe [CertificateStatus])
getCertificates_certificateStatuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificates' {Maybe [CertificateStatus]
certificateStatuses :: Maybe [CertificateStatus]
$sel:certificateStatuses:GetCertificates' :: GetCertificates -> Maybe [CertificateStatus]
certificateStatuses} -> Maybe [CertificateStatus]
certificateStatuses) (\s :: GetCertificates
s@GetCertificates' {} Maybe [CertificateStatus]
a -> GetCertificates
s {$sel:certificateStatuses:GetCertificates' :: Maybe [CertificateStatus]
certificateStatuses = Maybe [CertificateStatus]
a} :: GetCertificates) 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

-- | Indicates whether to include detailed information about the certificates
-- in the response.
--
-- When omitted, the response includes only the certificate names, Amazon
-- Resource Names (ARNs), domain names, and tags.
getCertificates_includeCertificateDetails :: Lens.Lens' GetCertificates (Prelude.Maybe Prelude.Bool)
getCertificates_includeCertificateDetails :: Lens' GetCertificates (Maybe Bool)
getCertificates_includeCertificateDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificates' {Maybe Bool
includeCertificateDetails :: Maybe Bool
$sel:includeCertificateDetails:GetCertificates' :: GetCertificates -> Maybe Bool
includeCertificateDetails} -> Maybe Bool
includeCertificateDetails) (\s :: GetCertificates
s@GetCertificates' {} Maybe Bool
a -> GetCertificates
s {$sel:includeCertificateDetails:GetCertificates' :: Maybe Bool
includeCertificateDetails = Maybe Bool
a} :: GetCertificates)

instance Core.AWSRequest GetCertificates where
  type
    AWSResponse GetCertificates =
      GetCertificatesResponse
  request :: (Service -> Service) -> GetCertificates -> Request GetCertificates
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 GetCertificates
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCertificates)))
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 [CertificateSummary] -> Int -> GetCertificatesResponse
GetCertificatesResponse'
            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
"certificates" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 GetCertificates where
  hashWithSalt :: Int -> GetCertificates -> Int
hashWithSalt Int
_salt GetCertificates' {Maybe Bool
Maybe [CertificateStatus]
Maybe Text
includeCertificateDetails :: Maybe Bool
certificateStatuses :: Maybe [CertificateStatus]
certificateName :: Maybe Text
$sel:includeCertificateDetails:GetCertificates' :: GetCertificates -> Maybe Bool
$sel:certificateStatuses:GetCertificates' :: GetCertificates -> Maybe [CertificateStatus]
$sel:certificateName:GetCertificates' :: GetCertificates -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CertificateStatus]
certificateStatuses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeCertificateDetails

instance Prelude.NFData GetCertificates where
  rnf :: GetCertificates -> ()
rnf GetCertificates' {Maybe Bool
Maybe [CertificateStatus]
Maybe Text
includeCertificateDetails :: Maybe Bool
certificateStatuses :: Maybe [CertificateStatus]
certificateName :: Maybe Text
$sel:includeCertificateDetails:GetCertificates' :: GetCertificates -> Maybe Bool
$sel:certificateStatuses:GetCertificates' :: GetCertificates -> Maybe [CertificateStatus]
$sel:certificateName:GetCertificates' :: GetCertificates -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CertificateStatus]
certificateStatuses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeCertificateDetails

instance Data.ToHeaders GetCertificates where
  toHeaders :: GetCertificates -> 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.GetCertificates" ::
                          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 GetCertificates where
  toJSON :: GetCertificates -> Value
toJSON GetCertificates' {Maybe Bool
Maybe [CertificateStatus]
Maybe Text
includeCertificateDetails :: Maybe Bool
certificateStatuses :: Maybe [CertificateStatus]
certificateName :: Maybe Text
$sel:includeCertificateDetails:GetCertificates' :: GetCertificates -> Maybe Bool
$sel:certificateStatuses:GetCertificates' :: GetCertificates -> Maybe [CertificateStatus]
$sel:certificateName:GetCertificates' :: GetCertificates -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"certificateName" 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
certificateName,
            (Key
"certificateStatuses" 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 [CertificateStatus]
certificateStatuses,
            (Key
"includeCertificateDetails" 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
includeCertificateDetails
          ]
      )

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

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

-- | /See:/ 'newGetCertificatesResponse' smart constructor.
data GetCertificatesResponse = GetCertificatesResponse'
  { -- | An object that describes certificates.
    GetCertificatesResponse -> Maybe [CertificateSummary]
certificates :: Prelude.Maybe [CertificateSummary],
    -- | The response's http status code.
    GetCertificatesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCertificatesResponse -> GetCertificatesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCertificatesResponse -> GetCertificatesResponse -> Bool
$c/= :: GetCertificatesResponse -> GetCertificatesResponse -> Bool
== :: GetCertificatesResponse -> GetCertificatesResponse -> Bool
$c== :: GetCertificatesResponse -> GetCertificatesResponse -> Bool
Prelude.Eq, ReadPrec [GetCertificatesResponse]
ReadPrec GetCertificatesResponse
Int -> ReadS GetCertificatesResponse
ReadS [GetCertificatesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCertificatesResponse]
$creadListPrec :: ReadPrec [GetCertificatesResponse]
readPrec :: ReadPrec GetCertificatesResponse
$creadPrec :: ReadPrec GetCertificatesResponse
readList :: ReadS [GetCertificatesResponse]
$creadList :: ReadS [GetCertificatesResponse]
readsPrec :: Int -> ReadS GetCertificatesResponse
$creadsPrec :: Int -> ReadS GetCertificatesResponse
Prelude.Read, Int -> GetCertificatesResponse -> ShowS
[GetCertificatesResponse] -> ShowS
GetCertificatesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCertificatesResponse] -> ShowS
$cshowList :: [GetCertificatesResponse] -> ShowS
show :: GetCertificatesResponse -> String
$cshow :: GetCertificatesResponse -> String
showsPrec :: Int -> GetCertificatesResponse -> ShowS
$cshowsPrec :: Int -> GetCertificatesResponse -> ShowS
Prelude.Show, forall x. Rep GetCertificatesResponse x -> GetCertificatesResponse
forall x. GetCertificatesResponse -> Rep GetCertificatesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCertificatesResponse x -> GetCertificatesResponse
$cfrom :: forall x. GetCertificatesResponse -> Rep GetCertificatesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCertificatesResponse' 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:
--
-- 'certificates', 'getCertificatesResponse_certificates' - An object that describes certificates.
--
-- 'httpStatus', 'getCertificatesResponse_httpStatus' - The response's http status code.
newGetCertificatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCertificatesResponse
newGetCertificatesResponse :: Int -> GetCertificatesResponse
newGetCertificatesResponse Int
pHttpStatus_ =
  GetCertificatesResponse'
    { $sel:certificates:GetCertificatesResponse' :: Maybe [CertificateSummary]
certificates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCertificatesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes certificates.
getCertificatesResponse_certificates :: Lens.Lens' GetCertificatesResponse (Prelude.Maybe [CertificateSummary])
getCertificatesResponse_certificates :: Lens' GetCertificatesResponse (Maybe [CertificateSummary])
getCertificatesResponse_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificatesResponse' {Maybe [CertificateSummary]
certificates :: Maybe [CertificateSummary]
$sel:certificates:GetCertificatesResponse' :: GetCertificatesResponse -> Maybe [CertificateSummary]
certificates} -> Maybe [CertificateSummary]
certificates) (\s :: GetCertificatesResponse
s@GetCertificatesResponse' {} Maybe [CertificateSummary]
a -> GetCertificatesResponse
s {$sel:certificates:GetCertificatesResponse' :: Maybe [CertificateSummary]
certificates = Maybe [CertificateSummary]
a} :: GetCertificatesResponse) 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 response's http status code.
getCertificatesResponse_httpStatus :: Lens.Lens' GetCertificatesResponse Prelude.Int
getCertificatesResponse_httpStatus :: Lens' GetCertificatesResponse Int
getCertificatesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificatesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCertificatesResponse' :: GetCertificatesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCertificatesResponse
s@GetCertificatesResponse' {} Int
a -> GetCertificatesResponse
s {$sel:httpStatus:GetCertificatesResponse' :: Int
httpStatus = Int
a} :: GetCertificatesResponse)

instance Prelude.NFData GetCertificatesResponse where
  rnf :: GetCertificatesResponse -> ()
rnf GetCertificatesResponse' {Int
Maybe [CertificateSummary]
httpStatus :: Int
certificates :: Maybe [CertificateSummary]
$sel:httpStatus:GetCertificatesResponse' :: GetCertificatesResponse -> Int
$sel:certificates:GetCertificatesResponse' :: GetCertificatesResponse -> Maybe [CertificateSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CertificateSummary]
certificates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus