{-# 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.Inspector2.UpdateConfiguration
-- 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 setting configurations for your Amazon Inspector account. When
-- you use this API as an Amazon Inspector delegated administrator this
-- updates the setting for all accounts you manage. Member accounts in an
-- organization cannot update this setting.
module Amazonka.Inspector2.UpdateConfiguration
  ( -- * Creating a Request
    UpdateConfiguration (..),
    newUpdateConfiguration,

    -- * Request Lenses
    updateConfiguration_ecrConfiguration,

    -- * Destructuring the Response
    UpdateConfigurationResponse (..),
    newUpdateConfigurationResponse,

    -- * Response Lenses
    updateConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateConfiguration' smart constructor.
data UpdateConfiguration = UpdateConfiguration'
  { -- | Specifies how the ECR automated re-scan will be updated for your
    -- environment.
    UpdateConfiguration -> EcrConfiguration
ecrConfiguration :: EcrConfiguration
  }
  deriving (UpdateConfiguration -> UpdateConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConfiguration -> UpdateConfiguration -> Bool
$c/= :: UpdateConfiguration -> UpdateConfiguration -> Bool
== :: UpdateConfiguration -> UpdateConfiguration -> Bool
$c== :: UpdateConfiguration -> UpdateConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateConfiguration]
ReadPrec UpdateConfiguration
Int -> ReadS UpdateConfiguration
ReadS [UpdateConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateConfiguration]
$creadListPrec :: ReadPrec [UpdateConfiguration]
readPrec :: ReadPrec UpdateConfiguration
$creadPrec :: ReadPrec UpdateConfiguration
readList :: ReadS [UpdateConfiguration]
$creadList :: ReadS [UpdateConfiguration]
readsPrec :: Int -> ReadS UpdateConfiguration
$creadsPrec :: Int -> ReadS UpdateConfiguration
Prelude.Read, Int -> UpdateConfiguration -> ShowS
[UpdateConfiguration] -> ShowS
UpdateConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConfiguration] -> ShowS
$cshowList :: [UpdateConfiguration] -> ShowS
show :: UpdateConfiguration -> String
$cshow :: UpdateConfiguration -> String
showsPrec :: Int -> UpdateConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateConfiguration -> ShowS
Prelude.Show, forall x. Rep UpdateConfiguration x -> UpdateConfiguration
forall x. UpdateConfiguration -> Rep UpdateConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateConfiguration x -> UpdateConfiguration
$cfrom :: forall x. UpdateConfiguration -> Rep UpdateConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConfiguration' 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:
--
-- 'ecrConfiguration', 'updateConfiguration_ecrConfiguration' - Specifies how the ECR automated re-scan will be updated for your
-- environment.
newUpdateConfiguration ::
  -- | 'ecrConfiguration'
  EcrConfiguration ->
  UpdateConfiguration
newUpdateConfiguration :: EcrConfiguration -> UpdateConfiguration
newUpdateConfiguration EcrConfiguration
pEcrConfiguration_ =
  UpdateConfiguration'
    { $sel:ecrConfiguration:UpdateConfiguration' :: EcrConfiguration
ecrConfiguration =
        EcrConfiguration
pEcrConfiguration_
    }

-- | Specifies how the ECR automated re-scan will be updated for your
-- environment.
updateConfiguration_ecrConfiguration :: Lens.Lens' UpdateConfiguration EcrConfiguration
updateConfiguration_ecrConfiguration :: Lens' UpdateConfiguration EcrConfiguration
updateConfiguration_ecrConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConfiguration' {EcrConfiguration
ecrConfiguration :: EcrConfiguration
$sel:ecrConfiguration:UpdateConfiguration' :: UpdateConfiguration -> EcrConfiguration
ecrConfiguration} -> EcrConfiguration
ecrConfiguration) (\s :: UpdateConfiguration
s@UpdateConfiguration' {} EcrConfiguration
a -> UpdateConfiguration
s {$sel:ecrConfiguration:UpdateConfiguration' :: EcrConfiguration
ecrConfiguration = EcrConfiguration
a} :: UpdateConfiguration)

instance Core.AWSRequest UpdateConfiguration where
  type
    AWSResponse UpdateConfiguration =
      UpdateConfigurationResponse
  request :: (Service -> Service)
-> UpdateConfiguration -> Request UpdateConfiguration
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 UpdateConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateConfigurationResponse
UpdateConfigurationResponse'
            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))
      )

instance Prelude.Hashable UpdateConfiguration where
  hashWithSalt :: Int -> UpdateConfiguration -> Int
hashWithSalt Int
_salt UpdateConfiguration' {EcrConfiguration
ecrConfiguration :: EcrConfiguration
$sel:ecrConfiguration:UpdateConfiguration' :: UpdateConfiguration -> EcrConfiguration
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EcrConfiguration
ecrConfiguration

instance Prelude.NFData UpdateConfiguration where
  rnf :: UpdateConfiguration -> ()
rnf UpdateConfiguration' {EcrConfiguration
ecrConfiguration :: EcrConfiguration
$sel:ecrConfiguration:UpdateConfiguration' :: UpdateConfiguration -> EcrConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf EcrConfiguration
ecrConfiguration

instance Data.ToHeaders UpdateConfiguration where
  toHeaders :: UpdateConfiguration -> 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.ToJSON UpdateConfiguration where
  toJSON :: UpdateConfiguration -> Value
toJSON UpdateConfiguration' {EcrConfiguration
ecrConfiguration :: EcrConfiguration
$sel:ecrConfiguration:UpdateConfiguration' :: UpdateConfiguration -> EcrConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ecrConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EcrConfiguration
ecrConfiguration)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateConfigurationResponse' 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', 'updateConfigurationResponse_httpStatus' - The response's http status code.
newUpdateConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateConfigurationResponse
newUpdateConfigurationResponse :: Int -> UpdateConfigurationResponse
newUpdateConfigurationResponse Int
pHttpStatus_ =
  UpdateConfigurationResponse'
    { $sel:httpStatus:UpdateConfigurationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateConfigurationResponse where
  rnf :: UpdateConfigurationResponse -> ()
rnf UpdateConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateConfigurationResponse' :: UpdateConfigurationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus