{-# 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.RolesAnywhere.ImportCrl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports the certificate revocation list (CRL). CRl is a list of
-- certificates that have been revoked by the issuing certificate Authority
-- (CA). IAM Roles Anywhere validates against the crl list before issuing
-- credentials.
--
-- __Required permissions:__ @rolesanywhere:ImportCrl@.
module Amazonka.RolesAnywhere.ImportCrl
  ( -- * Creating a Request
    ImportCrl (..),
    newImportCrl,

    -- * Request Lenses
    importCrl_enabled,
    importCrl_tags,
    importCrl_crlData,
    importCrl_name,
    importCrl_trustAnchorArn,

    -- * Destructuring the Response
    CrlDetailResponse (..),
    newCrlDetailResponse,

    -- * Response Lenses
    crlDetailResponse_crl,
  )
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.RolesAnywhere.Types

-- | /See:/ 'newImportCrl' smart constructor.
data ImportCrl = ImportCrl'
  { -- | Specifies whether the certificate revocation list (CRL) is enabled.
    ImportCrl -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | A list of tags to attach to the certificate revocation list (CRL).
    ImportCrl -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The x509 v3 specified certificate revocation list
    ImportCrl -> Base64
crlData :: Data.Base64,
    -- | The name of the certificate revocation list (CRL).
    ImportCrl -> Text
name :: Prelude.Text,
    -- | The ARN of the TrustAnchor the certificate revocation list (CRL) will
    -- provide revocation for.
    ImportCrl -> Text
trustAnchorArn :: Prelude.Text
  }
  deriving (ImportCrl -> ImportCrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportCrl -> ImportCrl -> Bool
$c/= :: ImportCrl -> ImportCrl -> Bool
== :: ImportCrl -> ImportCrl -> Bool
$c== :: ImportCrl -> ImportCrl -> Bool
Prelude.Eq, Int -> ImportCrl -> ShowS
[ImportCrl] -> ShowS
ImportCrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportCrl] -> ShowS
$cshowList :: [ImportCrl] -> ShowS
show :: ImportCrl -> String
$cshow :: ImportCrl -> String
showsPrec :: Int -> ImportCrl -> ShowS
$cshowsPrec :: Int -> ImportCrl -> ShowS
Prelude.Show, forall x. Rep ImportCrl x -> ImportCrl
forall x. ImportCrl -> Rep ImportCrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportCrl x -> ImportCrl
$cfrom :: forall x. ImportCrl -> Rep ImportCrl x
Prelude.Generic)

-- |
-- Create a value of 'ImportCrl' 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:
--
-- 'enabled', 'importCrl_enabled' - Specifies whether the certificate revocation list (CRL) is enabled.
--
-- 'tags', 'importCrl_tags' - A list of tags to attach to the certificate revocation list (CRL).
--
-- 'crlData', 'importCrl_crlData' - The x509 v3 specified certificate revocation list--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'name', 'importCrl_name' - The name of the certificate revocation list (CRL).
--
-- 'trustAnchorArn', 'importCrl_trustAnchorArn' - The ARN of the TrustAnchor the certificate revocation list (CRL) will
-- provide revocation for.
newImportCrl ::
  -- | 'crlData'
  Prelude.ByteString ->
  -- | 'name'
  Prelude.Text ->
  -- | 'trustAnchorArn'
  Prelude.Text ->
  ImportCrl
newImportCrl :: ByteString -> Text -> Text -> ImportCrl
newImportCrl ByteString
pCrlData_ Text
pName_ Text
pTrustAnchorArn_ =
  ImportCrl'
    { $sel:enabled:ImportCrl' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportCrl' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:crlData:ImportCrl' :: Base64
crlData = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pCrlData_,
      $sel:name:ImportCrl' :: Text
name = Text
pName_,
      $sel:trustAnchorArn:ImportCrl' :: Text
trustAnchorArn = Text
pTrustAnchorArn_
    }

-- | Specifies whether the certificate revocation list (CRL) is enabled.
importCrl_enabled :: Lens.Lens' ImportCrl (Prelude.Maybe Prelude.Bool)
importCrl_enabled :: Lens' ImportCrl (Maybe Bool)
importCrl_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCrl' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:ImportCrl' :: ImportCrl -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: ImportCrl
s@ImportCrl' {} Maybe Bool
a -> ImportCrl
s {$sel:enabled:ImportCrl' :: Maybe Bool
enabled = Maybe Bool
a} :: ImportCrl)

-- | A list of tags to attach to the certificate revocation list (CRL).
importCrl_tags :: Lens.Lens' ImportCrl (Prelude.Maybe [Tag])
importCrl_tags :: Lens' ImportCrl (Maybe [Tag])
importCrl_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCrl' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportCrl' :: ImportCrl -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportCrl
s@ImportCrl' {} Maybe [Tag]
a -> ImportCrl
s {$sel:tags:ImportCrl' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportCrl) 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 x509 v3 specified certificate revocation list--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
importCrl_crlData :: Lens.Lens' ImportCrl Prelude.ByteString
importCrl_crlData :: Lens' ImportCrl ByteString
importCrl_crlData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCrl' {Base64
crlData :: Base64
$sel:crlData:ImportCrl' :: ImportCrl -> Base64
crlData} -> Base64
crlData) (\s :: ImportCrl
s@ImportCrl' {} Base64
a -> ImportCrl
s {$sel:crlData:ImportCrl' :: Base64
crlData = Base64
a} :: ImportCrl) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The name of the certificate revocation list (CRL).
importCrl_name :: Lens.Lens' ImportCrl Prelude.Text
importCrl_name :: Lens' ImportCrl Text
importCrl_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCrl' {Text
name :: Text
$sel:name:ImportCrl' :: ImportCrl -> Text
name} -> Text
name) (\s :: ImportCrl
s@ImportCrl' {} Text
a -> ImportCrl
s {$sel:name:ImportCrl' :: Text
name = Text
a} :: ImportCrl)

-- | The ARN of the TrustAnchor the certificate revocation list (CRL) will
-- provide revocation for.
importCrl_trustAnchorArn :: Lens.Lens' ImportCrl Prelude.Text
importCrl_trustAnchorArn :: Lens' ImportCrl Text
importCrl_trustAnchorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCrl' {Text
trustAnchorArn :: Text
$sel:trustAnchorArn:ImportCrl' :: ImportCrl -> Text
trustAnchorArn} -> Text
trustAnchorArn) (\s :: ImportCrl
s@ImportCrl' {} Text
a -> ImportCrl
s {$sel:trustAnchorArn:ImportCrl' :: Text
trustAnchorArn = Text
a} :: ImportCrl)

instance Core.AWSRequest ImportCrl where
  type AWSResponse ImportCrl = CrlDetailResponse
  request :: (Service -> Service) -> ImportCrl -> Request ImportCrl
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 ImportCrl
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportCrl)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable ImportCrl where
  hashWithSalt :: Int -> ImportCrl -> Int
hashWithSalt Int
_salt ImportCrl' {Maybe Bool
Maybe [Tag]
Text
Base64
trustAnchorArn :: Text
name :: Text
crlData :: Base64
tags :: Maybe [Tag]
enabled :: Maybe Bool
$sel:trustAnchorArn:ImportCrl' :: ImportCrl -> Text
$sel:name:ImportCrl' :: ImportCrl -> Text
$sel:crlData:ImportCrl' :: ImportCrl -> Base64
$sel:tags:ImportCrl' :: ImportCrl -> Maybe [Tag]
$sel:enabled:ImportCrl' :: ImportCrl -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
crlData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trustAnchorArn

instance Prelude.NFData ImportCrl where
  rnf :: ImportCrl -> ()
rnf ImportCrl' {Maybe Bool
Maybe [Tag]
Text
Base64
trustAnchorArn :: Text
name :: Text
crlData :: Base64
tags :: Maybe [Tag]
enabled :: Maybe Bool
$sel:trustAnchorArn:ImportCrl' :: ImportCrl -> Text
$sel:name:ImportCrl' :: ImportCrl -> Text
$sel:crlData:ImportCrl' :: ImportCrl -> Base64
$sel:tags:ImportCrl' :: ImportCrl -> Maybe [Tag]
$sel:enabled:ImportCrl' :: ImportCrl -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
crlData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trustAnchorArn

instance Data.ToHeaders ImportCrl where
  toHeaders :: ImportCrl -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ImportCrl where
  toJSON :: ImportCrl -> Value
toJSON ImportCrl' {Maybe Bool
Maybe [Tag]
Text
Base64
trustAnchorArn :: Text
name :: Text
crlData :: Base64
tags :: Maybe [Tag]
enabled :: Maybe Bool
$sel:trustAnchorArn:ImportCrl' :: ImportCrl -> Text
$sel:name:ImportCrl' :: ImportCrl -> Text
$sel:crlData:ImportCrl' :: ImportCrl -> Base64
$sel:tags:ImportCrl' :: ImportCrl -> Maybe [Tag]
$sel:enabled:ImportCrl' :: ImportCrl -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"enabled" 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
enabled,
            (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"crlData" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
crlData),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"trustAnchorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trustAnchorArn)
          ]
      )

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

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