{-# 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.AccessAnalyzer.CreateAccessPreview
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an access preview that allows you to preview IAM Access Analyzer
-- findings for your resource before deploying resource permissions.
module Amazonka.AccessAnalyzer.CreateAccessPreview
  ( -- * Creating a Request
    CreateAccessPreview (..),
    newCreateAccessPreview,

    -- * Request Lenses
    createAccessPreview_clientToken,
    createAccessPreview_analyzerArn,
    createAccessPreview_configurations,

    -- * Destructuring the Response
    CreateAccessPreviewResponse (..),
    newCreateAccessPreviewResponse,

    -- * Response Lenses
    createAccessPreviewResponse_httpStatus,
    createAccessPreviewResponse_id,
  )
where

import Amazonka.AccessAnalyzer.Types
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

-- | /See:/ 'newCreateAccessPreview' smart constructor.
data CreateAccessPreview = CreateAccessPreview'
  { -- | A client token.
    CreateAccessPreview -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the account analyzer>
    -- used to generate the access preview. You can only create an access
    -- preview for analyzers with an @Account@ type and @Active@ status.
    CreateAccessPreview -> Text
analyzerArn :: Prelude.Text,
    -- | Access control configuration for your resource that is used to generate
    -- the access preview. The access preview includes findings for external
    -- access allowed to the resource with the proposed access control
    -- configuration. The configuration must contain exactly one element.
    CreateAccessPreview -> HashMap Text Configuration
configurations :: Prelude.HashMap Prelude.Text Configuration
  }
  deriving (CreateAccessPreview -> CreateAccessPreview -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessPreview -> CreateAccessPreview -> Bool
$c/= :: CreateAccessPreview -> CreateAccessPreview -> Bool
== :: CreateAccessPreview -> CreateAccessPreview -> Bool
$c== :: CreateAccessPreview -> CreateAccessPreview -> Bool
Prelude.Eq, ReadPrec [CreateAccessPreview]
ReadPrec CreateAccessPreview
Int -> ReadS CreateAccessPreview
ReadS [CreateAccessPreview]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccessPreview]
$creadListPrec :: ReadPrec [CreateAccessPreview]
readPrec :: ReadPrec CreateAccessPreview
$creadPrec :: ReadPrec CreateAccessPreview
readList :: ReadS [CreateAccessPreview]
$creadList :: ReadS [CreateAccessPreview]
readsPrec :: Int -> ReadS CreateAccessPreview
$creadsPrec :: Int -> ReadS CreateAccessPreview
Prelude.Read, Int -> CreateAccessPreview -> ShowS
[CreateAccessPreview] -> ShowS
CreateAccessPreview -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessPreview] -> ShowS
$cshowList :: [CreateAccessPreview] -> ShowS
show :: CreateAccessPreview -> String
$cshow :: CreateAccessPreview -> String
showsPrec :: Int -> CreateAccessPreview -> ShowS
$cshowsPrec :: Int -> CreateAccessPreview -> ShowS
Prelude.Show, forall x. Rep CreateAccessPreview x -> CreateAccessPreview
forall x. CreateAccessPreview -> Rep CreateAccessPreview x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAccessPreview x -> CreateAccessPreview
$cfrom :: forall x. CreateAccessPreview -> Rep CreateAccessPreview x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessPreview' 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:
--
-- 'clientToken', 'createAccessPreview_clientToken' - A client token.
--
-- 'analyzerArn', 'createAccessPreview_analyzerArn' - The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the account analyzer>
-- used to generate the access preview. You can only create an access
-- preview for analyzers with an @Account@ type and @Active@ status.
--
-- 'configurations', 'createAccessPreview_configurations' - Access control configuration for your resource that is used to generate
-- the access preview. The access preview includes findings for external
-- access allowed to the resource with the proposed access control
-- configuration. The configuration must contain exactly one element.
newCreateAccessPreview ::
  -- | 'analyzerArn'
  Prelude.Text ->
  CreateAccessPreview
newCreateAccessPreview :: Text -> CreateAccessPreview
newCreateAccessPreview Text
pAnalyzerArn_ =
  CreateAccessPreview'
    { $sel:clientToken:CreateAccessPreview' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerArn:CreateAccessPreview' :: Text
analyzerArn = Text
pAnalyzerArn_,
      $sel:configurations:CreateAccessPreview' :: HashMap Text Configuration
configurations = forall a. Monoid a => a
Prelude.mempty
    }

-- | A client token.
createAccessPreview_clientToken :: Lens.Lens' CreateAccessPreview (Prelude.Maybe Prelude.Text)
createAccessPreview_clientToken :: Lens' CreateAccessPreview (Maybe Text)
createAccessPreview_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessPreview' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateAccessPreview' :: CreateAccessPreview -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateAccessPreview
s@CreateAccessPreview' {} Maybe Text
a -> CreateAccessPreview
s {$sel:clientToken:CreateAccessPreview' :: Maybe Text
clientToken = Maybe Text
a} :: CreateAccessPreview)

-- | The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the account analyzer>
-- used to generate the access preview. You can only create an access
-- preview for analyzers with an @Account@ type and @Active@ status.
createAccessPreview_analyzerArn :: Lens.Lens' CreateAccessPreview Prelude.Text
createAccessPreview_analyzerArn :: Lens' CreateAccessPreview Text
createAccessPreview_analyzerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessPreview' {Text
analyzerArn :: Text
$sel:analyzerArn:CreateAccessPreview' :: CreateAccessPreview -> Text
analyzerArn} -> Text
analyzerArn) (\s :: CreateAccessPreview
s@CreateAccessPreview' {} Text
a -> CreateAccessPreview
s {$sel:analyzerArn:CreateAccessPreview' :: Text
analyzerArn = Text
a} :: CreateAccessPreview)

-- | Access control configuration for your resource that is used to generate
-- the access preview. The access preview includes findings for external
-- access allowed to the resource with the proposed access control
-- configuration. The configuration must contain exactly one element.
createAccessPreview_configurations :: Lens.Lens' CreateAccessPreview (Prelude.HashMap Prelude.Text Configuration)
createAccessPreview_configurations :: Lens' CreateAccessPreview (HashMap Text Configuration)
createAccessPreview_configurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessPreview' {HashMap Text Configuration
configurations :: HashMap Text Configuration
$sel:configurations:CreateAccessPreview' :: CreateAccessPreview -> HashMap Text Configuration
configurations} -> HashMap Text Configuration
configurations) (\s :: CreateAccessPreview
s@CreateAccessPreview' {} HashMap Text Configuration
a -> CreateAccessPreview
s {$sel:configurations:CreateAccessPreview' :: HashMap Text Configuration
configurations = HashMap Text Configuration
a} :: CreateAccessPreview) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateAccessPreview where
  type
    AWSResponse CreateAccessPreview =
      CreateAccessPreviewResponse
  request :: (Service -> Service)
-> CreateAccessPreview -> Request CreateAccessPreview
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateAccessPreview
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAccessPreview)))
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 -> CreateAccessPreviewResponse
CreateAccessPreviewResponse'
            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
"id")
      )

instance Prelude.Hashable CreateAccessPreview where
  hashWithSalt :: Int -> CreateAccessPreview -> Int
hashWithSalt Int
_salt CreateAccessPreview' {Maybe Text
Text
HashMap Text Configuration
configurations :: HashMap Text Configuration
analyzerArn :: Text
clientToken :: Maybe Text
$sel:configurations:CreateAccessPreview' :: CreateAccessPreview -> HashMap Text Configuration
$sel:analyzerArn:CreateAccessPreview' :: CreateAccessPreview -> Text
$sel:clientToken:CreateAccessPreview' :: CreateAccessPreview -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analyzerArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Configuration
configurations

instance Prelude.NFData CreateAccessPreview where
  rnf :: CreateAccessPreview -> ()
rnf CreateAccessPreview' {Maybe Text
Text
HashMap Text Configuration
configurations :: HashMap Text Configuration
analyzerArn :: Text
clientToken :: Maybe Text
$sel:configurations:CreateAccessPreview' :: CreateAccessPreview -> HashMap Text Configuration
$sel:analyzerArn:CreateAccessPreview' :: CreateAccessPreview -> Text
$sel:clientToken:CreateAccessPreview' :: CreateAccessPreview -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
analyzerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Configuration
configurations

instance Data.ToHeaders CreateAccessPreview where
  toHeaders :: CreateAccessPreview -> 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 CreateAccessPreview where
  toJSON :: CreateAccessPreview -> Value
toJSON CreateAccessPreview' {Maybe Text
Text
HashMap Text Configuration
configurations :: HashMap Text Configuration
analyzerArn :: Text
clientToken :: Maybe Text
$sel:configurations:CreateAccessPreview' :: CreateAccessPreview -> HashMap Text Configuration
$sel:analyzerArn:CreateAccessPreview' :: CreateAccessPreview -> Text
$sel:clientToken:CreateAccessPreview' :: CreateAccessPreview -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"analyzerArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
analyzerArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"configurations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Configuration
configurations)
          ]
      )

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

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

-- | /See:/ 'newCreateAccessPreviewResponse' smart constructor.
data CreateAccessPreviewResponse = CreateAccessPreviewResponse'
  { -- | The response's http status code.
    CreateAccessPreviewResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique ID for the access preview.
    CreateAccessPreviewResponse -> Text
id :: Prelude.Text
  }
  deriving (CreateAccessPreviewResponse -> CreateAccessPreviewResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessPreviewResponse -> CreateAccessPreviewResponse -> Bool
$c/= :: CreateAccessPreviewResponse -> CreateAccessPreviewResponse -> Bool
== :: CreateAccessPreviewResponse -> CreateAccessPreviewResponse -> Bool
$c== :: CreateAccessPreviewResponse -> CreateAccessPreviewResponse -> Bool
Prelude.Eq, ReadPrec [CreateAccessPreviewResponse]
ReadPrec CreateAccessPreviewResponse
Int -> ReadS CreateAccessPreviewResponse
ReadS [CreateAccessPreviewResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccessPreviewResponse]
$creadListPrec :: ReadPrec [CreateAccessPreviewResponse]
readPrec :: ReadPrec CreateAccessPreviewResponse
$creadPrec :: ReadPrec CreateAccessPreviewResponse
readList :: ReadS [CreateAccessPreviewResponse]
$creadList :: ReadS [CreateAccessPreviewResponse]
readsPrec :: Int -> ReadS CreateAccessPreviewResponse
$creadsPrec :: Int -> ReadS CreateAccessPreviewResponse
Prelude.Read, Int -> CreateAccessPreviewResponse -> ShowS
[CreateAccessPreviewResponse] -> ShowS
CreateAccessPreviewResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessPreviewResponse] -> ShowS
$cshowList :: [CreateAccessPreviewResponse] -> ShowS
show :: CreateAccessPreviewResponse -> String
$cshow :: CreateAccessPreviewResponse -> String
showsPrec :: Int -> CreateAccessPreviewResponse -> ShowS
$cshowsPrec :: Int -> CreateAccessPreviewResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAccessPreviewResponse x -> CreateAccessPreviewResponse
forall x.
CreateAccessPreviewResponse -> Rep CreateAccessPreviewResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAccessPreviewResponse x -> CreateAccessPreviewResponse
$cfrom :: forall x.
CreateAccessPreviewResponse -> Rep CreateAccessPreviewResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessPreviewResponse' 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', 'createAccessPreviewResponse_httpStatus' - The response's http status code.
--
-- 'id', 'createAccessPreviewResponse_id' - The unique ID for the access preview.
newCreateAccessPreviewResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'id'
  Prelude.Text ->
  CreateAccessPreviewResponse
newCreateAccessPreviewResponse :: Int -> Text -> CreateAccessPreviewResponse
newCreateAccessPreviewResponse Int
pHttpStatus_ Text
pId_ =
  CreateAccessPreviewResponse'
    { $sel:httpStatus:CreateAccessPreviewResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:id:CreateAccessPreviewResponse' :: Text
id = Text
pId_
    }

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

-- | The unique ID for the access preview.
createAccessPreviewResponse_id :: Lens.Lens' CreateAccessPreviewResponse Prelude.Text
createAccessPreviewResponse_id :: Lens' CreateAccessPreviewResponse Text
createAccessPreviewResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessPreviewResponse' {Text
id :: Text
$sel:id:CreateAccessPreviewResponse' :: CreateAccessPreviewResponse -> Text
id} -> Text
id) (\s :: CreateAccessPreviewResponse
s@CreateAccessPreviewResponse' {} Text
a -> CreateAccessPreviewResponse
s {$sel:id:CreateAccessPreviewResponse' :: Text
id = Text
a} :: CreateAccessPreviewResponse)

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