{-# 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.CreateArchiveRule
-- 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 archive rule for the specified analyzer. Archive rules
-- automatically archive new findings that meet the criteria you define
-- when you create the rule.
--
-- To learn about filter keys that you can use to create an archive rule,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-reference-filter-keys.html IAM Access Analyzer filter keys>
-- in the __IAM User Guide__.
module Amazonka.AccessAnalyzer.CreateArchiveRule
  ( -- * Creating a Request
    CreateArchiveRule (..),
    newCreateArchiveRule,

    -- * Request Lenses
    createArchiveRule_clientToken,
    createArchiveRule_analyzerName,
    createArchiveRule_ruleName,
    createArchiveRule_filter,

    -- * Destructuring the Response
    CreateArchiveRuleResponse (..),
    newCreateArchiveRuleResponse,
  )
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

-- | Creates an archive rule.
--
-- /See:/ 'newCreateArchiveRule' smart constructor.
data CreateArchiveRule = CreateArchiveRule'
  { -- | A client token.
    CreateArchiveRule -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the created analyzer.
    CreateArchiveRule -> Text
analyzerName :: Prelude.Text,
    -- | The name of the rule to create.
    CreateArchiveRule -> Text
ruleName :: Prelude.Text,
    -- | The criteria for the rule.
    CreateArchiveRule -> HashMap Text Criterion
filter' :: Prelude.HashMap Prelude.Text Criterion
  }
  deriving (CreateArchiveRule -> CreateArchiveRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateArchiveRule -> CreateArchiveRule -> Bool
$c/= :: CreateArchiveRule -> CreateArchiveRule -> Bool
== :: CreateArchiveRule -> CreateArchiveRule -> Bool
$c== :: CreateArchiveRule -> CreateArchiveRule -> Bool
Prelude.Eq, ReadPrec [CreateArchiveRule]
ReadPrec CreateArchiveRule
Int -> ReadS CreateArchiveRule
ReadS [CreateArchiveRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateArchiveRule]
$creadListPrec :: ReadPrec [CreateArchiveRule]
readPrec :: ReadPrec CreateArchiveRule
$creadPrec :: ReadPrec CreateArchiveRule
readList :: ReadS [CreateArchiveRule]
$creadList :: ReadS [CreateArchiveRule]
readsPrec :: Int -> ReadS CreateArchiveRule
$creadsPrec :: Int -> ReadS CreateArchiveRule
Prelude.Read, Int -> CreateArchiveRule -> ShowS
[CreateArchiveRule] -> ShowS
CreateArchiveRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateArchiveRule] -> ShowS
$cshowList :: [CreateArchiveRule] -> ShowS
show :: CreateArchiveRule -> String
$cshow :: CreateArchiveRule -> String
showsPrec :: Int -> CreateArchiveRule -> ShowS
$cshowsPrec :: Int -> CreateArchiveRule -> ShowS
Prelude.Show, forall x. Rep CreateArchiveRule x -> CreateArchiveRule
forall x. CreateArchiveRule -> Rep CreateArchiveRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateArchiveRule x -> CreateArchiveRule
$cfrom :: forall x. CreateArchiveRule -> Rep CreateArchiveRule x
Prelude.Generic)

-- |
-- Create a value of 'CreateArchiveRule' 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', 'createArchiveRule_clientToken' - A client token.
--
-- 'analyzerName', 'createArchiveRule_analyzerName' - The name of the created analyzer.
--
-- 'ruleName', 'createArchiveRule_ruleName' - The name of the rule to create.
--
-- 'filter'', 'createArchiveRule_filter' - The criteria for the rule.
newCreateArchiveRule ::
  -- | 'analyzerName'
  Prelude.Text ->
  -- | 'ruleName'
  Prelude.Text ->
  CreateArchiveRule
newCreateArchiveRule :: Text -> Text -> CreateArchiveRule
newCreateArchiveRule Text
pAnalyzerName_ Text
pRuleName_ =
  CreateArchiveRule'
    { $sel:clientToken:CreateArchiveRule' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerName:CreateArchiveRule' :: Text
analyzerName = Text
pAnalyzerName_,
      $sel:ruleName:CreateArchiveRule' :: Text
ruleName = Text
pRuleName_,
      $sel:filter':CreateArchiveRule' :: HashMap Text Criterion
filter' = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | The name of the created analyzer.
createArchiveRule_analyzerName :: Lens.Lens' CreateArchiveRule Prelude.Text
createArchiveRule_analyzerName :: Lens' CreateArchiveRule Text
createArchiveRule_analyzerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchiveRule' {Text
analyzerName :: Text
$sel:analyzerName:CreateArchiveRule' :: CreateArchiveRule -> Text
analyzerName} -> Text
analyzerName) (\s :: CreateArchiveRule
s@CreateArchiveRule' {} Text
a -> CreateArchiveRule
s {$sel:analyzerName:CreateArchiveRule' :: Text
analyzerName = Text
a} :: CreateArchiveRule)

-- | The name of the rule to create.
createArchiveRule_ruleName :: Lens.Lens' CreateArchiveRule Prelude.Text
createArchiveRule_ruleName :: Lens' CreateArchiveRule Text
createArchiveRule_ruleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchiveRule' {Text
ruleName :: Text
$sel:ruleName:CreateArchiveRule' :: CreateArchiveRule -> Text
ruleName} -> Text
ruleName) (\s :: CreateArchiveRule
s@CreateArchiveRule' {} Text
a -> CreateArchiveRule
s {$sel:ruleName:CreateArchiveRule' :: Text
ruleName = Text
a} :: CreateArchiveRule)

-- | The criteria for the rule.
createArchiveRule_filter :: Lens.Lens' CreateArchiveRule (Prelude.HashMap Prelude.Text Criterion)
createArchiveRule_filter :: Lens' CreateArchiveRule (HashMap Text Criterion)
createArchiveRule_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchiveRule' {HashMap Text Criterion
filter' :: HashMap Text Criterion
$sel:filter':CreateArchiveRule' :: CreateArchiveRule -> HashMap Text Criterion
filter'} -> HashMap Text Criterion
filter') (\s :: CreateArchiveRule
s@CreateArchiveRule' {} HashMap Text Criterion
a -> CreateArchiveRule
s {$sel:filter':CreateArchiveRule' :: HashMap Text Criterion
filter' = HashMap Text Criterion
a} :: CreateArchiveRule) 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 CreateArchiveRule where
  type
    AWSResponse CreateArchiveRule =
      CreateArchiveRuleResponse
  request :: (Service -> Service)
-> CreateArchiveRule -> Request CreateArchiveRule
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 CreateArchiveRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateArchiveRule)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull CreateArchiveRuleResponse
CreateArchiveRuleResponse'

instance Prelude.Hashable CreateArchiveRule where
  hashWithSalt :: Int -> CreateArchiveRule -> Int
hashWithSalt Int
_salt CreateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':CreateArchiveRule' :: CreateArchiveRule -> HashMap Text Criterion
$sel:ruleName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:analyzerName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:clientToken:CreateArchiveRule' :: CreateArchiveRule -> 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
analyzerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Criterion
filter'

instance Prelude.NFData CreateArchiveRule where
  rnf :: CreateArchiveRule -> ()
rnf CreateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':CreateArchiveRule' :: CreateArchiveRule -> HashMap Text Criterion
$sel:ruleName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:analyzerName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:clientToken:CreateArchiveRule' :: CreateArchiveRule -> 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
analyzerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ruleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Criterion
filter'

instance Data.ToHeaders CreateArchiveRule where
  toHeaders :: CreateArchiveRule -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateArchiveRule where
  toJSON :: CreateArchiveRule -> Value
toJSON CreateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':CreateArchiveRule' :: CreateArchiveRule -> HashMap Text Criterion
$sel:ruleName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:analyzerName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:clientToken:CreateArchiveRule' :: CreateArchiveRule -> 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
"ruleName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ruleName),
            forall a. a -> Maybe a
Prelude.Just (Key
"filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Criterion
filter')
          ]
      )

instance Data.ToPath CreateArchiveRule where
  toPath :: CreateArchiveRule -> ByteString
toPath CreateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':CreateArchiveRule' :: CreateArchiveRule -> HashMap Text Criterion
$sel:ruleName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:analyzerName:CreateArchiveRule' :: CreateArchiveRule -> Text
$sel:clientToken:CreateArchiveRule' :: CreateArchiveRule -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/analyzer/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
analyzerName,
        ByteString
"/archive-rule"
      ]

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

-- | /See:/ 'newCreateArchiveRuleResponse' smart constructor.
data CreateArchiveRuleResponse = CreateArchiveRuleResponse'
  {
  }
  deriving (CreateArchiveRuleResponse -> CreateArchiveRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateArchiveRuleResponse -> CreateArchiveRuleResponse -> Bool
$c/= :: CreateArchiveRuleResponse -> CreateArchiveRuleResponse -> Bool
== :: CreateArchiveRuleResponse -> CreateArchiveRuleResponse -> Bool
$c== :: CreateArchiveRuleResponse -> CreateArchiveRuleResponse -> Bool
Prelude.Eq, ReadPrec [CreateArchiveRuleResponse]
ReadPrec CreateArchiveRuleResponse
Int -> ReadS CreateArchiveRuleResponse
ReadS [CreateArchiveRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateArchiveRuleResponse]
$creadListPrec :: ReadPrec [CreateArchiveRuleResponse]
readPrec :: ReadPrec CreateArchiveRuleResponse
$creadPrec :: ReadPrec CreateArchiveRuleResponse
readList :: ReadS [CreateArchiveRuleResponse]
$creadList :: ReadS [CreateArchiveRuleResponse]
readsPrec :: Int -> ReadS CreateArchiveRuleResponse
$creadsPrec :: Int -> ReadS CreateArchiveRuleResponse
Prelude.Read, Int -> CreateArchiveRuleResponse -> ShowS
[CreateArchiveRuleResponse] -> ShowS
CreateArchiveRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateArchiveRuleResponse] -> ShowS
$cshowList :: [CreateArchiveRuleResponse] -> ShowS
show :: CreateArchiveRuleResponse -> String
$cshow :: CreateArchiveRuleResponse -> String
showsPrec :: Int -> CreateArchiveRuleResponse -> ShowS
$cshowsPrec :: Int -> CreateArchiveRuleResponse -> ShowS
Prelude.Show, forall x.
Rep CreateArchiveRuleResponse x -> CreateArchiveRuleResponse
forall x.
CreateArchiveRuleResponse -> Rep CreateArchiveRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateArchiveRuleResponse x -> CreateArchiveRuleResponse
$cfrom :: forall x.
CreateArchiveRuleResponse -> Rep CreateArchiveRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateArchiveRuleResponse' 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.
newCreateArchiveRuleResponse ::
  CreateArchiveRuleResponse
newCreateArchiveRuleResponse :: CreateArchiveRuleResponse
newCreateArchiveRuleResponse =
  CreateArchiveRuleResponse
CreateArchiveRuleResponse'

instance Prelude.NFData CreateArchiveRuleResponse where
  rnf :: CreateArchiveRuleResponse -> ()
rnf CreateArchiveRuleResponse
_ = ()