{-# 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.ECR.GetRegistryScanningConfiguration
-- 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 the scanning configuration for a registry.
module Amazonka.ECR.GetRegistryScanningConfiguration
  ( -- * Creating a Request
    GetRegistryScanningConfiguration (..),
    newGetRegistryScanningConfiguration,

    -- * Destructuring the Response
    GetRegistryScanningConfigurationResponse (..),
    newGetRegistryScanningConfigurationResponse,

    -- * Response Lenses
    getRegistryScanningConfigurationResponse_registryId,
    getRegistryScanningConfigurationResponse_scanningConfiguration,
    getRegistryScanningConfigurationResponse_httpStatus,
  )
where

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

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

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

instance
  Core.AWSRequest
    GetRegistryScanningConfiguration
  where
  type
    AWSResponse GetRegistryScanningConfiguration =
      GetRegistryScanningConfigurationResponse
  request :: (Service -> Service)
-> GetRegistryScanningConfiguration
-> Request GetRegistryScanningConfiguration
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 GetRegistryScanningConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetRegistryScanningConfiguration)))
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 Text
-> Maybe RegistryScanningConfiguration
-> Int
-> GetRegistryScanningConfigurationResponse
GetRegistryScanningConfigurationResponse'
            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
"registryId")
            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
"scanningConfiguration")
            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
    GetRegistryScanningConfiguration
  where
  hashWithSalt :: Int -> GetRegistryScanningConfiguration -> Int
hashWithSalt Int
_salt GetRegistryScanningConfiguration
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance
  Data.ToHeaders
    GetRegistryScanningConfiguration
  where
  toHeaders :: GetRegistryScanningConfiguration -> 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
"AmazonEC2ContainerRegistry_V20150921.GetRegistryScanningConfiguration" ::
                          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 GetRegistryScanningConfiguration where
  toJSON :: GetRegistryScanningConfiguration -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newGetRegistryScanningConfigurationResponse' smart constructor.
data GetRegistryScanningConfigurationResponse = GetRegistryScanningConfigurationResponse'
  { -- | The ID of the registry.
    GetRegistryScanningConfigurationResponse -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The scanning configuration for the registry.
    GetRegistryScanningConfigurationResponse
-> Maybe RegistryScanningConfiguration
scanningConfiguration :: Prelude.Maybe RegistryScanningConfiguration,
    -- | The response's http status code.
    GetRegistryScanningConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRegistryScanningConfigurationResponse
-> GetRegistryScanningConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRegistryScanningConfigurationResponse
-> GetRegistryScanningConfigurationResponse -> Bool
$c/= :: GetRegistryScanningConfigurationResponse
-> GetRegistryScanningConfigurationResponse -> Bool
== :: GetRegistryScanningConfigurationResponse
-> GetRegistryScanningConfigurationResponse -> Bool
$c== :: GetRegistryScanningConfigurationResponse
-> GetRegistryScanningConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetRegistryScanningConfigurationResponse]
ReadPrec GetRegistryScanningConfigurationResponse
Int -> ReadS GetRegistryScanningConfigurationResponse
ReadS [GetRegistryScanningConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRegistryScanningConfigurationResponse]
$creadListPrec :: ReadPrec [GetRegistryScanningConfigurationResponse]
readPrec :: ReadPrec GetRegistryScanningConfigurationResponse
$creadPrec :: ReadPrec GetRegistryScanningConfigurationResponse
readList :: ReadS [GetRegistryScanningConfigurationResponse]
$creadList :: ReadS [GetRegistryScanningConfigurationResponse]
readsPrec :: Int -> ReadS GetRegistryScanningConfigurationResponse
$creadsPrec :: Int -> ReadS GetRegistryScanningConfigurationResponse
Prelude.Read, Int -> GetRegistryScanningConfigurationResponse -> ShowS
[GetRegistryScanningConfigurationResponse] -> ShowS
GetRegistryScanningConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRegistryScanningConfigurationResponse] -> ShowS
$cshowList :: [GetRegistryScanningConfigurationResponse] -> ShowS
show :: GetRegistryScanningConfigurationResponse -> String
$cshow :: GetRegistryScanningConfigurationResponse -> String
showsPrec :: Int -> GetRegistryScanningConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetRegistryScanningConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetRegistryScanningConfigurationResponse x
-> GetRegistryScanningConfigurationResponse
forall x.
GetRegistryScanningConfigurationResponse
-> Rep GetRegistryScanningConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRegistryScanningConfigurationResponse x
-> GetRegistryScanningConfigurationResponse
$cfrom :: forall x.
GetRegistryScanningConfigurationResponse
-> Rep GetRegistryScanningConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRegistryScanningConfigurationResponse' 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:
--
-- 'registryId', 'getRegistryScanningConfigurationResponse_registryId' - The ID of the registry.
--
-- 'scanningConfiguration', 'getRegistryScanningConfigurationResponse_scanningConfiguration' - The scanning configuration for the registry.
--
-- 'httpStatus', 'getRegistryScanningConfigurationResponse_httpStatus' - The response's http status code.
newGetRegistryScanningConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRegistryScanningConfigurationResponse
newGetRegistryScanningConfigurationResponse :: Int -> GetRegistryScanningConfigurationResponse
newGetRegistryScanningConfigurationResponse
  Int
pHttpStatus_ =
    GetRegistryScanningConfigurationResponse'
      { $sel:registryId:GetRegistryScanningConfigurationResponse' :: Maybe Text
registryId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:scanningConfiguration:GetRegistryScanningConfigurationResponse' :: Maybe RegistryScanningConfiguration
scanningConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetRegistryScanningConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the registry.
getRegistryScanningConfigurationResponse_registryId :: Lens.Lens' GetRegistryScanningConfigurationResponse (Prelude.Maybe Prelude.Text)
getRegistryScanningConfigurationResponse_registryId :: Lens' GetRegistryScanningConfigurationResponse (Maybe Text)
getRegistryScanningConfigurationResponse_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRegistryScanningConfigurationResponse' {Maybe Text
registryId :: Maybe Text
$sel:registryId:GetRegistryScanningConfigurationResponse' :: GetRegistryScanningConfigurationResponse -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: GetRegistryScanningConfigurationResponse
s@GetRegistryScanningConfigurationResponse' {} Maybe Text
a -> GetRegistryScanningConfigurationResponse
s {$sel:registryId:GetRegistryScanningConfigurationResponse' :: Maybe Text
registryId = Maybe Text
a} :: GetRegistryScanningConfigurationResponse)

-- | The scanning configuration for the registry.
getRegistryScanningConfigurationResponse_scanningConfiguration :: Lens.Lens' GetRegistryScanningConfigurationResponse (Prelude.Maybe RegistryScanningConfiguration)
getRegistryScanningConfigurationResponse_scanningConfiguration :: Lens'
  GetRegistryScanningConfigurationResponse
  (Maybe RegistryScanningConfiguration)
getRegistryScanningConfigurationResponse_scanningConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRegistryScanningConfigurationResponse' {Maybe RegistryScanningConfiguration
scanningConfiguration :: Maybe RegistryScanningConfiguration
$sel:scanningConfiguration:GetRegistryScanningConfigurationResponse' :: GetRegistryScanningConfigurationResponse
-> Maybe RegistryScanningConfiguration
scanningConfiguration} -> Maybe RegistryScanningConfiguration
scanningConfiguration) (\s :: GetRegistryScanningConfigurationResponse
s@GetRegistryScanningConfigurationResponse' {} Maybe RegistryScanningConfiguration
a -> GetRegistryScanningConfigurationResponse
s {$sel:scanningConfiguration:GetRegistryScanningConfigurationResponse' :: Maybe RegistryScanningConfiguration
scanningConfiguration = Maybe RegistryScanningConfiguration
a} :: GetRegistryScanningConfigurationResponse)

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

instance
  Prelude.NFData
    GetRegistryScanningConfigurationResponse
  where
  rnf :: GetRegistryScanningConfigurationResponse -> ()
rnf GetRegistryScanningConfigurationResponse' {Int
Maybe Text
Maybe RegistryScanningConfiguration
httpStatus :: Int
scanningConfiguration :: Maybe RegistryScanningConfiguration
registryId :: Maybe Text
$sel:httpStatus:GetRegistryScanningConfigurationResponse' :: GetRegistryScanningConfigurationResponse -> Int
$sel:scanningConfiguration:GetRegistryScanningConfigurationResponse' :: GetRegistryScanningConfigurationResponse
-> Maybe RegistryScanningConfiguration
$sel:registryId:GetRegistryScanningConfigurationResponse' :: GetRegistryScanningConfigurationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RegistryScanningConfiguration
scanningConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus