{-# 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.UpdateArchiveRule
-- 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 criteria and values for the specified archive rule.
module Amazonka.AccessAnalyzer.UpdateArchiveRule
  ( -- * Creating a Request
    UpdateArchiveRule (..),
    newUpdateArchiveRule,

    -- * Request Lenses
    updateArchiveRule_clientToken,
    updateArchiveRule_analyzerName,
    updateArchiveRule_ruleName,
    updateArchiveRule_filter,

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

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

-- |
-- Create a value of 'UpdateArchiveRule' 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', 'updateArchiveRule_clientToken' - A client token.
--
-- 'analyzerName', 'updateArchiveRule_analyzerName' - The name of the analyzer to update the archive rules for.
--
-- 'ruleName', 'updateArchiveRule_ruleName' - The name of the rule to update.
--
-- 'filter'', 'updateArchiveRule_filter' - A filter to match for the rules to update. Only rules that match the
-- filter are updated.
newUpdateArchiveRule ::
  -- | 'analyzerName'
  Prelude.Text ->
  -- | 'ruleName'
  Prelude.Text ->
  UpdateArchiveRule
newUpdateArchiveRule :: Text -> Text -> UpdateArchiveRule
newUpdateArchiveRule Text
pAnalyzerName_ Text
pRuleName_ =
  UpdateArchiveRule'
    { $sel:clientToken:UpdateArchiveRule' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerName:UpdateArchiveRule' :: Text
analyzerName = Text
pAnalyzerName_,
      $sel:ruleName:UpdateArchiveRule' :: Text
ruleName = Text
pRuleName_,
      $sel:filter':UpdateArchiveRule' :: HashMap Text Criterion
filter' = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | The name of the analyzer to update the archive rules for.
updateArchiveRule_analyzerName :: Lens.Lens' UpdateArchiveRule Prelude.Text
updateArchiveRule_analyzerName :: Lens' UpdateArchiveRule Text
updateArchiveRule_analyzerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveRule' {Text
analyzerName :: Text
$sel:analyzerName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
analyzerName} -> Text
analyzerName) (\s :: UpdateArchiveRule
s@UpdateArchiveRule' {} Text
a -> UpdateArchiveRule
s {$sel:analyzerName:UpdateArchiveRule' :: Text
analyzerName = Text
a} :: UpdateArchiveRule)

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

-- | A filter to match for the rules to update. Only rules that match the
-- filter are updated.
updateArchiveRule_filter :: Lens.Lens' UpdateArchiveRule (Prelude.HashMap Prelude.Text Criterion)
updateArchiveRule_filter :: Lens' UpdateArchiveRule (HashMap Text Criterion)
updateArchiveRule_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveRule' {HashMap Text Criterion
filter' :: HashMap Text Criterion
$sel:filter':UpdateArchiveRule' :: UpdateArchiveRule -> HashMap Text Criterion
filter'} -> HashMap Text Criterion
filter') (\s :: UpdateArchiveRule
s@UpdateArchiveRule' {} HashMap Text Criterion
a -> UpdateArchiveRule
s {$sel:filter':UpdateArchiveRule' :: HashMap Text Criterion
filter' = HashMap Text Criterion
a} :: UpdateArchiveRule) 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 UpdateArchiveRule where
  type
    AWSResponse UpdateArchiveRule =
      UpdateArchiveRuleResponse
  request :: (Service -> Service)
-> UpdateArchiveRule -> Request UpdateArchiveRule
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 UpdateArchiveRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateArchiveRule)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateArchiveRuleResponse
UpdateArchiveRuleResponse'

instance Prelude.Hashable UpdateArchiveRule where
  hashWithSalt :: Int -> UpdateArchiveRule -> Int
hashWithSalt Int
_salt UpdateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':UpdateArchiveRule' :: UpdateArchiveRule -> HashMap Text Criterion
$sel:ruleName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:analyzerName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:clientToken:UpdateArchiveRule' :: UpdateArchiveRule -> 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 UpdateArchiveRule where
  rnf :: UpdateArchiveRule -> ()
rnf UpdateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':UpdateArchiveRule' :: UpdateArchiveRule -> HashMap Text Criterion
$sel:ruleName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:analyzerName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:clientToken:UpdateArchiveRule' :: UpdateArchiveRule -> 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 UpdateArchiveRule where
  toHeaders :: UpdateArchiveRule -> [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 UpdateArchiveRule where
  toJSON :: UpdateArchiveRule -> Value
toJSON UpdateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':UpdateArchiveRule' :: UpdateArchiveRule -> HashMap Text Criterion
$sel:ruleName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:analyzerName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:clientToken:UpdateArchiveRule' :: UpdateArchiveRule -> 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
"filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Criterion
filter')
          ]
      )

instance Data.ToPath UpdateArchiveRule where
  toPath :: UpdateArchiveRule -> ByteString
toPath UpdateArchiveRule' {Maybe Text
Text
HashMap Text Criterion
filter' :: HashMap Text Criterion
ruleName :: Text
analyzerName :: Text
clientToken :: Maybe Text
$sel:filter':UpdateArchiveRule' :: UpdateArchiveRule -> HashMap Text Criterion
$sel:ruleName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:analyzerName:UpdateArchiveRule' :: UpdateArchiveRule -> Text
$sel:clientToken:UpdateArchiveRule' :: UpdateArchiveRule -> 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/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
ruleName
      ]

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

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

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

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