{-# 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.GetArchiveRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about an archive 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.GetArchiveRule
  ( -- * Creating a Request
    GetArchiveRule (..),
    newGetArchiveRule,

    -- * Request Lenses
    getArchiveRule_analyzerName,
    getArchiveRule_ruleName,

    -- * Destructuring the Response
    GetArchiveRuleResponse (..),
    newGetArchiveRuleResponse,

    -- * Response Lenses
    getArchiveRuleResponse_httpStatus,
    getArchiveRuleResponse_archiveRule,
  )
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

-- | Retrieves an archive rule.
--
-- /See:/ 'newGetArchiveRule' smart constructor.
data GetArchiveRule = GetArchiveRule'
  { -- | The name of the analyzer to retrieve rules from.
    GetArchiveRule -> Text
analyzerName :: Prelude.Text,
    -- | The name of the rule to retrieve.
    GetArchiveRule -> Text
ruleName :: Prelude.Text
  }
  deriving (GetArchiveRule -> GetArchiveRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetArchiveRule -> GetArchiveRule -> Bool
$c/= :: GetArchiveRule -> GetArchiveRule -> Bool
== :: GetArchiveRule -> GetArchiveRule -> Bool
$c== :: GetArchiveRule -> GetArchiveRule -> Bool
Prelude.Eq, ReadPrec [GetArchiveRule]
ReadPrec GetArchiveRule
Int -> ReadS GetArchiveRule
ReadS [GetArchiveRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetArchiveRule]
$creadListPrec :: ReadPrec [GetArchiveRule]
readPrec :: ReadPrec GetArchiveRule
$creadPrec :: ReadPrec GetArchiveRule
readList :: ReadS [GetArchiveRule]
$creadList :: ReadS [GetArchiveRule]
readsPrec :: Int -> ReadS GetArchiveRule
$creadsPrec :: Int -> ReadS GetArchiveRule
Prelude.Read, Int -> GetArchiveRule -> ShowS
[GetArchiveRule] -> ShowS
GetArchiveRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetArchiveRule] -> ShowS
$cshowList :: [GetArchiveRule] -> ShowS
show :: GetArchiveRule -> String
$cshow :: GetArchiveRule -> String
showsPrec :: Int -> GetArchiveRule -> ShowS
$cshowsPrec :: Int -> GetArchiveRule -> ShowS
Prelude.Show, forall x. Rep GetArchiveRule x -> GetArchiveRule
forall x. GetArchiveRule -> Rep GetArchiveRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetArchiveRule x -> GetArchiveRule
$cfrom :: forall x. GetArchiveRule -> Rep GetArchiveRule x
Prelude.Generic)

-- |
-- Create a value of 'GetArchiveRule' 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:
--
-- 'analyzerName', 'getArchiveRule_analyzerName' - The name of the analyzer to retrieve rules from.
--
-- 'ruleName', 'getArchiveRule_ruleName' - The name of the rule to retrieve.
newGetArchiveRule ::
  -- | 'analyzerName'
  Prelude.Text ->
  -- | 'ruleName'
  Prelude.Text ->
  GetArchiveRule
newGetArchiveRule :: Text -> Text -> GetArchiveRule
newGetArchiveRule Text
pAnalyzerName_ Text
pRuleName_ =
  GetArchiveRule'
    { $sel:analyzerName:GetArchiveRule' :: Text
analyzerName = Text
pAnalyzerName_,
      $sel:ruleName:GetArchiveRule' :: Text
ruleName = Text
pRuleName_
    }

-- | The name of the analyzer to retrieve rules from.
getArchiveRule_analyzerName :: Lens.Lens' GetArchiveRule Prelude.Text
getArchiveRule_analyzerName :: Lens' GetArchiveRule Text
getArchiveRule_analyzerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetArchiveRule' {Text
analyzerName :: Text
$sel:analyzerName:GetArchiveRule' :: GetArchiveRule -> Text
analyzerName} -> Text
analyzerName) (\s :: GetArchiveRule
s@GetArchiveRule' {} Text
a -> GetArchiveRule
s {$sel:analyzerName:GetArchiveRule' :: Text
analyzerName = Text
a} :: GetArchiveRule)

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

instance Core.AWSRequest GetArchiveRule where
  type
    AWSResponse GetArchiveRule =
      GetArchiveRuleResponse
  request :: (Service -> Service) -> GetArchiveRule -> Request GetArchiveRule
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetArchiveRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetArchiveRule)))
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 -> ArchiveRuleSummary -> GetArchiveRuleResponse
GetArchiveRuleResponse'
            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
"archiveRule")
      )

instance Prelude.Hashable GetArchiveRule where
  hashWithSalt :: Int -> GetArchiveRule -> Int
hashWithSalt Int
_salt GetArchiveRule' {Text
ruleName :: Text
analyzerName :: Text
$sel:ruleName:GetArchiveRule' :: GetArchiveRule -> Text
$sel:analyzerName:GetArchiveRule' :: GetArchiveRule -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analyzerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleName

instance Prelude.NFData GetArchiveRule where
  rnf :: GetArchiveRule -> ()
rnf GetArchiveRule' {Text
ruleName :: Text
analyzerName :: Text
$sel:ruleName:GetArchiveRule' :: GetArchiveRule -> Text
$sel:analyzerName:GetArchiveRule' :: GetArchiveRule -> Text
..} =
    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

instance Data.ToHeaders GetArchiveRule where
  toHeaders :: GetArchiveRule -> 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.ToPath GetArchiveRule where
  toPath :: GetArchiveRule -> ByteString
toPath GetArchiveRule' {Text
ruleName :: Text
analyzerName :: Text
$sel:ruleName:GetArchiveRule' :: GetArchiveRule -> Text
$sel:analyzerName:GetArchiveRule' :: GetArchiveRule -> 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 GetArchiveRule where
  toQuery :: GetArchiveRule -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'GetArchiveRuleResponse' 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', 'getArchiveRuleResponse_httpStatus' - The response's http status code.
--
-- 'archiveRule', 'getArchiveRuleResponse_archiveRule' - Undocumented member.
newGetArchiveRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'archiveRule'
  ArchiveRuleSummary ->
  GetArchiveRuleResponse
newGetArchiveRuleResponse :: Int -> ArchiveRuleSummary -> GetArchiveRuleResponse
newGetArchiveRuleResponse Int
pHttpStatus_ ArchiveRuleSummary
pArchiveRule_ =
  GetArchiveRuleResponse'
    { $sel:httpStatus:GetArchiveRuleResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:archiveRule:GetArchiveRuleResponse' :: ArchiveRuleSummary
archiveRule = ArchiveRuleSummary
pArchiveRule_
    }

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

-- | Undocumented member.
getArchiveRuleResponse_archiveRule :: Lens.Lens' GetArchiveRuleResponse ArchiveRuleSummary
getArchiveRuleResponse_archiveRule :: Lens' GetArchiveRuleResponse ArchiveRuleSummary
getArchiveRuleResponse_archiveRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetArchiveRuleResponse' {ArchiveRuleSummary
archiveRule :: ArchiveRuleSummary
$sel:archiveRule:GetArchiveRuleResponse' :: GetArchiveRuleResponse -> ArchiveRuleSummary
archiveRule} -> ArchiveRuleSummary
archiveRule) (\s :: GetArchiveRuleResponse
s@GetArchiveRuleResponse' {} ArchiveRuleSummary
a -> GetArchiveRuleResponse
s {$sel:archiveRule:GetArchiveRuleResponse' :: ArchiveRuleSummary
archiveRule = ArchiveRuleSummary
a} :: GetArchiveRuleResponse)

instance Prelude.NFData GetArchiveRuleResponse where
  rnf :: GetArchiveRuleResponse -> ()
rnf GetArchiveRuleResponse' {Int
ArchiveRuleSummary
archiveRule :: ArchiveRuleSummary
httpStatus :: Int
$sel:archiveRule:GetArchiveRuleResponse' :: GetArchiveRuleResponse -> ArchiveRuleSummary
$sel:httpStatus:GetArchiveRuleResponse' :: GetArchiveRuleResponse -> 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 ArchiveRuleSummary
archiveRule