{-# 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.GetFinding
-- 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 the specified finding.
module Amazonka.AccessAnalyzer.GetFinding
  ( -- * Creating a Request
    GetFinding (..),
    newGetFinding,

    -- * Request Lenses
    getFinding_analyzerArn,
    getFinding_id,

    -- * Destructuring the Response
    GetFindingResponse (..),
    newGetFindingResponse,

    -- * Response Lenses
    getFindingResponse_finding,
    getFindingResponse_httpStatus,
  )
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 a finding.
--
-- /See:/ 'newGetFinding' smart constructor.
data GetFinding = GetFinding'
  { -- | The
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
    -- that generated the finding.
    GetFinding -> Text
analyzerArn :: Prelude.Text,
    -- | The ID of the finding to retrieve.
    GetFinding -> Text
id :: Prelude.Text
  }
  deriving (GetFinding -> GetFinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFinding -> GetFinding -> Bool
$c/= :: GetFinding -> GetFinding -> Bool
== :: GetFinding -> GetFinding -> Bool
$c== :: GetFinding -> GetFinding -> Bool
Prelude.Eq, ReadPrec [GetFinding]
ReadPrec GetFinding
Int -> ReadS GetFinding
ReadS [GetFinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFinding]
$creadListPrec :: ReadPrec [GetFinding]
readPrec :: ReadPrec GetFinding
$creadPrec :: ReadPrec GetFinding
readList :: ReadS [GetFinding]
$creadList :: ReadS [GetFinding]
readsPrec :: Int -> ReadS GetFinding
$creadsPrec :: Int -> ReadS GetFinding
Prelude.Read, Int -> GetFinding -> ShowS
[GetFinding] -> ShowS
GetFinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFinding] -> ShowS
$cshowList :: [GetFinding] -> ShowS
show :: GetFinding -> String
$cshow :: GetFinding -> String
showsPrec :: Int -> GetFinding -> ShowS
$cshowsPrec :: Int -> GetFinding -> ShowS
Prelude.Show, forall x. Rep GetFinding x -> GetFinding
forall x. GetFinding -> Rep GetFinding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFinding x -> GetFinding
$cfrom :: forall x. GetFinding -> Rep GetFinding x
Prelude.Generic)

-- |
-- Create a value of 'GetFinding' 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:
--
-- 'analyzerArn', 'getFinding_analyzerArn' - The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- that generated the finding.
--
-- 'id', 'getFinding_id' - The ID of the finding to retrieve.
newGetFinding ::
  -- | 'analyzerArn'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  GetFinding
newGetFinding :: Text -> Text -> GetFinding
newGetFinding Text
pAnalyzerArn_ Text
pId_ =
  GetFinding' {$sel:analyzerArn:GetFinding' :: Text
analyzerArn = Text
pAnalyzerArn_, $sel:id:GetFinding' :: Text
id = Text
pId_}

-- | The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- that generated the finding.
getFinding_analyzerArn :: Lens.Lens' GetFinding Prelude.Text
getFinding_analyzerArn :: Lens' GetFinding Text
getFinding_analyzerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFinding' {Text
analyzerArn :: Text
$sel:analyzerArn:GetFinding' :: GetFinding -> Text
analyzerArn} -> Text
analyzerArn) (\s :: GetFinding
s@GetFinding' {} Text
a -> GetFinding
s {$sel:analyzerArn:GetFinding' :: Text
analyzerArn = Text
a} :: GetFinding)

-- | The ID of the finding to retrieve.
getFinding_id :: Lens.Lens' GetFinding Prelude.Text
getFinding_id :: Lens' GetFinding Text
getFinding_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFinding' {Text
id :: Text
$sel:id:GetFinding' :: GetFinding -> Text
id} -> Text
id) (\s :: GetFinding
s@GetFinding' {} Text
a -> GetFinding
s {$sel:id:GetFinding' :: Text
id = Text
a} :: GetFinding)

instance Core.AWSRequest GetFinding where
  type AWSResponse GetFinding = GetFindingResponse
  request :: (Service -> Service) -> GetFinding -> Request GetFinding
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 GetFinding
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFinding)))
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 ->
          Maybe Finding -> Int -> GetFindingResponse
GetFindingResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"finding")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable GetFinding where
  hashWithSalt :: Int -> GetFinding -> Int
hashWithSalt Int
_salt GetFinding' {Text
id :: Text
analyzerArn :: Text
$sel:id:GetFinding' :: GetFinding -> Text
$sel:analyzerArn:GetFinding' :: GetFinding -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analyzerArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

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

instance Data.ToHeaders GetFinding where
  toHeaders :: GetFinding -> 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 GetFinding where
  toPath :: GetFinding -> ByteString
toPath GetFinding' {Text
id :: Text
analyzerArn :: Text
$sel:id:GetFinding' :: GetFinding -> Text
$sel:analyzerArn:GetFinding' :: GetFinding -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/finding/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

instance Data.ToQuery GetFinding where
  toQuery :: GetFinding -> QueryString
toQuery GetFinding' {Text
id :: Text
analyzerArn :: Text
$sel:id:GetFinding' :: GetFinding -> Text
$sel:analyzerArn:GetFinding' :: GetFinding -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"analyzerArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
analyzerArn]

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

-- |
-- Create a value of 'GetFindingResponse' 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:
--
-- 'finding', 'getFindingResponse_finding' - A @finding@ object that contains finding details.
--
-- 'httpStatus', 'getFindingResponse_httpStatus' - The response's http status code.
newGetFindingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFindingResponse
newGetFindingResponse :: Int -> GetFindingResponse
newGetFindingResponse Int
pHttpStatus_ =
  GetFindingResponse'
    { $sel:finding:GetFindingResponse' :: Maybe Finding
finding = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetFindingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A @finding@ object that contains finding details.
getFindingResponse_finding :: Lens.Lens' GetFindingResponse (Prelude.Maybe Finding)
getFindingResponse_finding :: Lens' GetFindingResponse (Maybe Finding)
getFindingResponse_finding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFindingResponse' {Maybe Finding
finding :: Maybe Finding
$sel:finding:GetFindingResponse' :: GetFindingResponse -> Maybe Finding
finding} -> Maybe Finding
finding) (\s :: GetFindingResponse
s@GetFindingResponse' {} Maybe Finding
a -> GetFindingResponse
s {$sel:finding:GetFindingResponse' :: Maybe Finding
finding = Maybe Finding
a} :: GetFindingResponse)

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

instance Prelude.NFData GetFindingResponse where
  rnf :: GetFindingResponse -> ()
rnf GetFindingResponse' {Int
Maybe Finding
httpStatus :: Int
finding :: Maybe Finding
$sel:httpStatus:GetFindingResponse' :: GetFindingResponse -> Int
$sel:finding:GetFindingResponse' :: GetFindingResponse -> Maybe Finding
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Finding
finding
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus