{-# 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.Inspector.AddAttributesToFindings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Assigns attributes (key and value pairs) to the findings that are
-- specified by the ARNs of the findings.
module Amazonka.Inspector.AddAttributesToFindings
  ( -- * Creating a Request
    AddAttributesToFindings (..),
    newAddAttributesToFindings,

    -- * Request Lenses
    addAttributesToFindings_findingArns,
    addAttributesToFindings_attributes,

    -- * Destructuring the Response
    AddAttributesToFindingsResponse (..),
    newAddAttributesToFindingsResponse,

    -- * Response Lenses
    addAttributesToFindingsResponse_httpStatus,
    addAttributesToFindingsResponse_failedItems,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Inspector.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newAddAttributesToFindings' smart constructor.
data AddAttributesToFindings = AddAttributesToFindings'
  { -- | The ARNs that specify the findings that you want to assign attributes
    -- to.
    AddAttributesToFindings -> NonEmpty Text
findingArns :: Prelude.NonEmpty Prelude.Text,
    -- | The array of attributes that you want to assign to specified findings.
    AddAttributesToFindings -> [Attribute]
attributes :: [Attribute]
  }
  deriving (AddAttributesToFindings -> AddAttributesToFindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddAttributesToFindings -> AddAttributesToFindings -> Bool
$c/= :: AddAttributesToFindings -> AddAttributesToFindings -> Bool
== :: AddAttributesToFindings -> AddAttributesToFindings -> Bool
$c== :: AddAttributesToFindings -> AddAttributesToFindings -> Bool
Prelude.Eq, ReadPrec [AddAttributesToFindings]
ReadPrec AddAttributesToFindings
Int -> ReadS AddAttributesToFindings
ReadS [AddAttributesToFindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddAttributesToFindings]
$creadListPrec :: ReadPrec [AddAttributesToFindings]
readPrec :: ReadPrec AddAttributesToFindings
$creadPrec :: ReadPrec AddAttributesToFindings
readList :: ReadS [AddAttributesToFindings]
$creadList :: ReadS [AddAttributesToFindings]
readsPrec :: Int -> ReadS AddAttributesToFindings
$creadsPrec :: Int -> ReadS AddAttributesToFindings
Prelude.Read, Int -> AddAttributesToFindings -> ShowS
[AddAttributesToFindings] -> ShowS
AddAttributesToFindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddAttributesToFindings] -> ShowS
$cshowList :: [AddAttributesToFindings] -> ShowS
show :: AddAttributesToFindings -> String
$cshow :: AddAttributesToFindings -> String
showsPrec :: Int -> AddAttributesToFindings -> ShowS
$cshowsPrec :: Int -> AddAttributesToFindings -> ShowS
Prelude.Show, forall x. Rep AddAttributesToFindings x -> AddAttributesToFindings
forall x. AddAttributesToFindings -> Rep AddAttributesToFindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddAttributesToFindings x -> AddAttributesToFindings
$cfrom :: forall x. AddAttributesToFindings -> Rep AddAttributesToFindings x
Prelude.Generic)

-- |
-- Create a value of 'AddAttributesToFindings' 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:
--
-- 'findingArns', 'addAttributesToFindings_findingArns' - The ARNs that specify the findings that you want to assign attributes
-- to.
--
-- 'attributes', 'addAttributesToFindings_attributes' - The array of attributes that you want to assign to specified findings.
newAddAttributesToFindings ::
  -- | 'findingArns'
  Prelude.NonEmpty Prelude.Text ->
  AddAttributesToFindings
newAddAttributesToFindings :: NonEmpty Text -> AddAttributesToFindings
newAddAttributesToFindings NonEmpty Text
pFindingArns_ =
  AddAttributesToFindings'
    { $sel:findingArns:AddAttributesToFindings' :: NonEmpty Text
findingArns =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pFindingArns_,
      $sel:attributes:AddAttributesToFindings' :: [Attribute]
attributes = forall a. Monoid a => a
Prelude.mempty
    }

-- | The ARNs that specify the findings that you want to assign attributes
-- to.
addAttributesToFindings_findingArns :: Lens.Lens' AddAttributesToFindings (Prelude.NonEmpty Prelude.Text)
addAttributesToFindings_findingArns :: Lens' AddAttributesToFindings (NonEmpty Text)
addAttributesToFindings_findingArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAttributesToFindings' {NonEmpty Text
findingArns :: NonEmpty Text
$sel:findingArns:AddAttributesToFindings' :: AddAttributesToFindings -> NonEmpty Text
findingArns} -> NonEmpty Text
findingArns) (\s :: AddAttributesToFindings
s@AddAttributesToFindings' {} NonEmpty Text
a -> AddAttributesToFindings
s {$sel:findingArns:AddAttributesToFindings' :: NonEmpty Text
findingArns = NonEmpty Text
a} :: AddAttributesToFindings) 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

-- | The array of attributes that you want to assign to specified findings.
addAttributesToFindings_attributes :: Lens.Lens' AddAttributesToFindings [Attribute]
addAttributesToFindings_attributes :: Lens' AddAttributesToFindings [Attribute]
addAttributesToFindings_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAttributesToFindings' {[Attribute]
attributes :: [Attribute]
$sel:attributes:AddAttributesToFindings' :: AddAttributesToFindings -> [Attribute]
attributes} -> [Attribute]
attributes) (\s :: AddAttributesToFindings
s@AddAttributesToFindings' {} [Attribute]
a -> AddAttributesToFindings
s {$sel:attributes:AddAttributesToFindings' :: [Attribute]
attributes = [Attribute]
a} :: AddAttributesToFindings) 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 AddAttributesToFindings where
  type
    AWSResponse AddAttributesToFindings =
      AddAttributesToFindingsResponse
  request :: (Service -> Service)
-> AddAttributesToFindings -> Request AddAttributesToFindings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AddAttributesToFindings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddAttributesToFindings)))
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
-> HashMap Text FailedItemDetails
-> AddAttributesToFindingsResponse
AddAttributesToFindingsResponse'
            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 (Maybe a)
Data..?> Key
"failedItems" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable AddAttributesToFindings where
  hashWithSalt :: Int -> AddAttributesToFindings -> Int
hashWithSalt Int
_salt AddAttributesToFindings' {[Attribute]
NonEmpty Text
attributes :: [Attribute]
findingArns :: NonEmpty Text
$sel:attributes:AddAttributesToFindings' :: AddAttributesToFindings -> [Attribute]
$sel:findingArns:AddAttributesToFindings' :: AddAttributesToFindings -> NonEmpty Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
findingArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Attribute]
attributes

instance Prelude.NFData AddAttributesToFindings where
  rnf :: AddAttributesToFindings -> ()
rnf AddAttributesToFindings' {[Attribute]
NonEmpty Text
attributes :: [Attribute]
findingArns :: NonEmpty Text
$sel:attributes:AddAttributesToFindings' :: AddAttributesToFindings -> [Attribute]
$sel:findingArns:AddAttributesToFindings' :: AddAttributesToFindings -> NonEmpty Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
findingArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Attribute]
attributes

instance Data.ToHeaders AddAttributesToFindings where
  toHeaders :: AddAttributesToFindings -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"InspectorService.AddAttributesToFindings" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AddAttributesToFindings where
  toJSON :: AddAttributesToFindings -> Value
toJSON AddAttributesToFindings' {[Attribute]
NonEmpty Text
attributes :: [Attribute]
findingArns :: NonEmpty Text
$sel:attributes:AddAttributesToFindings' :: AddAttributesToFindings -> [Attribute]
$sel:findingArns:AddAttributesToFindings' :: AddAttributesToFindings -> NonEmpty Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"findingArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
findingArns),
            forall a. a -> Maybe a
Prelude.Just (Key
"attributes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Attribute]
attributes)
          ]
      )

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

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

-- | /See:/ 'newAddAttributesToFindingsResponse' smart constructor.
data AddAttributesToFindingsResponse = AddAttributesToFindingsResponse'
  { -- | The response's http status code.
    AddAttributesToFindingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | Attribute details that cannot be described. An error code is provided
    -- for each failed item.
    AddAttributesToFindingsResponse -> HashMap Text FailedItemDetails
failedItems :: Prelude.HashMap Prelude.Text FailedItemDetails
  }
  deriving (AddAttributesToFindingsResponse
-> AddAttributesToFindingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddAttributesToFindingsResponse
-> AddAttributesToFindingsResponse -> Bool
$c/= :: AddAttributesToFindingsResponse
-> AddAttributesToFindingsResponse -> Bool
== :: AddAttributesToFindingsResponse
-> AddAttributesToFindingsResponse -> Bool
$c== :: AddAttributesToFindingsResponse
-> AddAttributesToFindingsResponse -> Bool
Prelude.Eq, ReadPrec [AddAttributesToFindingsResponse]
ReadPrec AddAttributesToFindingsResponse
Int -> ReadS AddAttributesToFindingsResponse
ReadS [AddAttributesToFindingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddAttributesToFindingsResponse]
$creadListPrec :: ReadPrec [AddAttributesToFindingsResponse]
readPrec :: ReadPrec AddAttributesToFindingsResponse
$creadPrec :: ReadPrec AddAttributesToFindingsResponse
readList :: ReadS [AddAttributesToFindingsResponse]
$creadList :: ReadS [AddAttributesToFindingsResponse]
readsPrec :: Int -> ReadS AddAttributesToFindingsResponse
$creadsPrec :: Int -> ReadS AddAttributesToFindingsResponse
Prelude.Read, Int -> AddAttributesToFindingsResponse -> ShowS
[AddAttributesToFindingsResponse] -> ShowS
AddAttributesToFindingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddAttributesToFindingsResponse] -> ShowS
$cshowList :: [AddAttributesToFindingsResponse] -> ShowS
show :: AddAttributesToFindingsResponse -> String
$cshow :: AddAttributesToFindingsResponse -> String
showsPrec :: Int -> AddAttributesToFindingsResponse -> ShowS
$cshowsPrec :: Int -> AddAttributesToFindingsResponse -> ShowS
Prelude.Show, forall x.
Rep AddAttributesToFindingsResponse x
-> AddAttributesToFindingsResponse
forall x.
AddAttributesToFindingsResponse
-> Rep AddAttributesToFindingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddAttributesToFindingsResponse x
-> AddAttributesToFindingsResponse
$cfrom :: forall x.
AddAttributesToFindingsResponse
-> Rep AddAttributesToFindingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddAttributesToFindingsResponse' 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', 'addAttributesToFindingsResponse_httpStatus' - The response's http status code.
--
-- 'failedItems', 'addAttributesToFindingsResponse_failedItems' - Attribute details that cannot be described. An error code is provided
-- for each failed item.
newAddAttributesToFindingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddAttributesToFindingsResponse
newAddAttributesToFindingsResponse :: Int -> AddAttributesToFindingsResponse
newAddAttributesToFindingsResponse Int
pHttpStatus_ =
  AddAttributesToFindingsResponse'
    { $sel:httpStatus:AddAttributesToFindingsResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:failedItems:AddAttributesToFindingsResponse' :: HashMap Text FailedItemDetails
failedItems = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Attribute details that cannot be described. An error code is provided
-- for each failed item.
addAttributesToFindingsResponse_failedItems :: Lens.Lens' AddAttributesToFindingsResponse (Prelude.HashMap Prelude.Text FailedItemDetails)
addAttributesToFindingsResponse_failedItems :: Lens'
  AddAttributesToFindingsResponse (HashMap Text FailedItemDetails)
addAttributesToFindingsResponse_failedItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAttributesToFindingsResponse' {HashMap Text FailedItemDetails
failedItems :: HashMap Text FailedItemDetails
$sel:failedItems:AddAttributesToFindingsResponse' :: AddAttributesToFindingsResponse -> HashMap Text FailedItemDetails
failedItems} -> HashMap Text FailedItemDetails
failedItems) (\s :: AddAttributesToFindingsResponse
s@AddAttributesToFindingsResponse' {} HashMap Text FailedItemDetails
a -> AddAttributesToFindingsResponse
s {$sel:failedItems:AddAttributesToFindingsResponse' :: HashMap Text FailedItemDetails
failedItems = HashMap Text FailedItemDetails
a} :: AddAttributesToFindingsResponse) 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
  Prelude.NFData
    AddAttributesToFindingsResponse
  where
  rnf :: AddAttributesToFindingsResponse -> ()
rnf AddAttributesToFindingsResponse' {Int
HashMap Text FailedItemDetails
failedItems :: HashMap Text FailedItemDetails
httpStatus :: Int
$sel:failedItems:AddAttributesToFindingsResponse' :: AddAttributesToFindingsResponse -> HashMap Text FailedItemDetails
$sel:httpStatus:AddAttributesToFindingsResponse' :: AddAttributesToFindingsResponse -> 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 HashMap Text FailedItemDetails
failedItems