{-# 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.ECRPublic.PutRepositoryCatalogData
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates the catalog data for a repository in a public
-- registry.
module Amazonka.ECRPublic.PutRepositoryCatalogData
  ( -- * Creating a Request
    PutRepositoryCatalogData (..),
    newPutRepositoryCatalogData,

    -- * Request Lenses
    putRepositoryCatalogData_registryId,
    putRepositoryCatalogData_repositoryName,
    putRepositoryCatalogData_catalogData,

    -- * Destructuring the Response
    PutRepositoryCatalogDataResponse (..),
    newPutRepositoryCatalogDataResponse,

    -- * Response Lenses
    putRepositoryCatalogDataResponse_catalogData,
    putRepositoryCatalogDataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutRepositoryCatalogData' smart constructor.
data PutRepositoryCatalogData = PutRepositoryCatalogData'
  { -- | The AWS account ID associated with the public registry the repository is
    -- in. If you do not specify a registry, the default public registry is
    -- assumed.
    PutRepositoryCatalogData -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository to create or update the catalog data for.
    PutRepositoryCatalogData -> Text
repositoryName :: Prelude.Text,
    -- | An object containing the catalog data for a repository. This data is
    -- publicly visible in the Amazon ECR Public Gallery.
    PutRepositoryCatalogData -> RepositoryCatalogDataInput
catalogData :: RepositoryCatalogDataInput
  }
  deriving (PutRepositoryCatalogData -> PutRepositoryCatalogData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRepositoryCatalogData -> PutRepositoryCatalogData -> Bool
$c/= :: PutRepositoryCatalogData -> PutRepositoryCatalogData -> Bool
== :: PutRepositoryCatalogData -> PutRepositoryCatalogData -> Bool
$c== :: PutRepositoryCatalogData -> PutRepositoryCatalogData -> Bool
Prelude.Eq, ReadPrec [PutRepositoryCatalogData]
ReadPrec PutRepositoryCatalogData
Int -> ReadS PutRepositoryCatalogData
ReadS [PutRepositoryCatalogData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRepositoryCatalogData]
$creadListPrec :: ReadPrec [PutRepositoryCatalogData]
readPrec :: ReadPrec PutRepositoryCatalogData
$creadPrec :: ReadPrec PutRepositoryCatalogData
readList :: ReadS [PutRepositoryCatalogData]
$creadList :: ReadS [PutRepositoryCatalogData]
readsPrec :: Int -> ReadS PutRepositoryCatalogData
$creadsPrec :: Int -> ReadS PutRepositoryCatalogData
Prelude.Read, Int -> PutRepositoryCatalogData -> ShowS
[PutRepositoryCatalogData] -> ShowS
PutRepositoryCatalogData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRepositoryCatalogData] -> ShowS
$cshowList :: [PutRepositoryCatalogData] -> ShowS
show :: PutRepositoryCatalogData -> String
$cshow :: PutRepositoryCatalogData -> String
showsPrec :: Int -> PutRepositoryCatalogData -> ShowS
$cshowsPrec :: Int -> PutRepositoryCatalogData -> ShowS
Prelude.Show, forall x.
Rep PutRepositoryCatalogData x -> PutRepositoryCatalogData
forall x.
PutRepositoryCatalogData -> Rep PutRepositoryCatalogData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutRepositoryCatalogData x -> PutRepositoryCatalogData
$cfrom :: forall x.
PutRepositoryCatalogData -> Rep PutRepositoryCatalogData x
Prelude.Generic)

-- |
-- Create a value of 'PutRepositoryCatalogData' 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', 'putRepositoryCatalogData_registryId' - The AWS account ID associated with the public registry the repository is
-- in. If you do not specify a registry, the default public registry is
-- assumed.
--
-- 'repositoryName', 'putRepositoryCatalogData_repositoryName' - The name of the repository to create or update the catalog data for.
--
-- 'catalogData', 'putRepositoryCatalogData_catalogData' - An object containing the catalog data for a repository. This data is
-- publicly visible in the Amazon ECR Public Gallery.
newPutRepositoryCatalogData ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'catalogData'
  RepositoryCatalogDataInput ->
  PutRepositoryCatalogData
newPutRepositoryCatalogData :: Text -> RepositoryCatalogDataInput -> PutRepositoryCatalogData
newPutRepositoryCatalogData
  Text
pRepositoryName_
  RepositoryCatalogDataInput
pCatalogData_ =
    PutRepositoryCatalogData'
      { $sel:registryId:PutRepositoryCatalogData' :: Maybe Text
registryId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:PutRepositoryCatalogData' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:catalogData:PutRepositoryCatalogData' :: RepositoryCatalogDataInput
catalogData = RepositoryCatalogDataInput
pCatalogData_
      }

-- | The AWS account ID associated with the public registry the repository is
-- in. If you do not specify a registry, the default public registry is
-- assumed.
putRepositoryCatalogData_registryId :: Lens.Lens' PutRepositoryCatalogData (Prelude.Maybe Prelude.Text)
putRepositoryCatalogData_registryId :: Lens' PutRepositoryCatalogData (Maybe Text)
putRepositoryCatalogData_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRepositoryCatalogData' {Maybe Text
registryId :: Maybe Text
$sel:registryId:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: PutRepositoryCatalogData
s@PutRepositoryCatalogData' {} Maybe Text
a -> PutRepositoryCatalogData
s {$sel:registryId:PutRepositoryCatalogData' :: Maybe Text
registryId = Maybe Text
a} :: PutRepositoryCatalogData)

-- | The name of the repository to create or update the catalog data for.
putRepositoryCatalogData_repositoryName :: Lens.Lens' PutRepositoryCatalogData Prelude.Text
putRepositoryCatalogData_repositoryName :: Lens' PutRepositoryCatalogData Text
putRepositoryCatalogData_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRepositoryCatalogData' {Text
repositoryName :: Text
$sel:repositoryName:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Text
repositoryName} -> Text
repositoryName) (\s :: PutRepositoryCatalogData
s@PutRepositoryCatalogData' {} Text
a -> PutRepositoryCatalogData
s {$sel:repositoryName:PutRepositoryCatalogData' :: Text
repositoryName = Text
a} :: PutRepositoryCatalogData)

-- | An object containing the catalog data for a repository. This data is
-- publicly visible in the Amazon ECR Public Gallery.
putRepositoryCatalogData_catalogData :: Lens.Lens' PutRepositoryCatalogData RepositoryCatalogDataInput
putRepositoryCatalogData_catalogData :: Lens' PutRepositoryCatalogData RepositoryCatalogDataInput
putRepositoryCatalogData_catalogData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRepositoryCatalogData' {RepositoryCatalogDataInput
catalogData :: RepositoryCatalogDataInput
$sel:catalogData:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> RepositoryCatalogDataInput
catalogData} -> RepositoryCatalogDataInput
catalogData) (\s :: PutRepositoryCatalogData
s@PutRepositoryCatalogData' {} RepositoryCatalogDataInput
a -> PutRepositoryCatalogData
s {$sel:catalogData:PutRepositoryCatalogData' :: RepositoryCatalogDataInput
catalogData = RepositoryCatalogDataInput
a} :: PutRepositoryCatalogData)

instance Core.AWSRequest PutRepositoryCatalogData where
  type
    AWSResponse PutRepositoryCatalogData =
      PutRepositoryCatalogDataResponse
  request :: (Service -> Service)
-> PutRepositoryCatalogData -> Request PutRepositoryCatalogData
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 PutRepositoryCatalogData
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutRepositoryCatalogData)))
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 RepositoryCatalogData
-> Int -> PutRepositoryCatalogDataResponse
PutRepositoryCatalogDataResponse'
            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
"catalogData")
            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 PutRepositoryCatalogData where
  hashWithSalt :: Int -> PutRepositoryCatalogData -> Int
hashWithSalt Int
_salt PutRepositoryCatalogData' {Maybe Text
Text
RepositoryCatalogDataInput
catalogData :: RepositoryCatalogDataInput
repositoryName :: Text
registryId :: Maybe Text
$sel:catalogData:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> RepositoryCatalogDataInput
$sel:repositoryName:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Text
$sel:registryId:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
registryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RepositoryCatalogDataInput
catalogData

instance Prelude.NFData PutRepositoryCatalogData where
  rnf :: PutRepositoryCatalogData -> ()
rnf PutRepositoryCatalogData' {Maybe Text
Text
RepositoryCatalogDataInput
catalogData :: RepositoryCatalogDataInput
repositoryName :: Text
registryId :: Maybe Text
$sel:catalogData:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> RepositoryCatalogDataInput
$sel:repositoryName:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Text
$sel:registryId:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> 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 Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RepositoryCatalogDataInput
catalogData

instance Data.ToHeaders PutRepositoryCatalogData where
  toHeaders :: PutRepositoryCatalogData -> 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
"SpencerFrontendService.PutRepositoryCatalogData" ::
                          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 PutRepositoryCatalogData where
  toJSON :: PutRepositoryCatalogData -> Value
toJSON PutRepositoryCatalogData' {Maybe Text
Text
RepositoryCatalogDataInput
catalogData :: RepositoryCatalogDataInput
repositoryName :: Text
registryId :: Maybe Text
$sel:catalogData:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> RepositoryCatalogDataInput
$sel:repositoryName:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Text
$sel:registryId:PutRepositoryCatalogData' :: PutRepositoryCatalogData -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"registryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
registryId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"catalogData" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RepositoryCatalogDataInput
catalogData)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutRepositoryCatalogDataResponse' 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:
--
-- 'catalogData', 'putRepositoryCatalogDataResponse_catalogData' - The catalog data for the repository.
--
-- 'httpStatus', 'putRepositoryCatalogDataResponse_httpStatus' - The response's http status code.
newPutRepositoryCatalogDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutRepositoryCatalogDataResponse
newPutRepositoryCatalogDataResponse :: Int -> PutRepositoryCatalogDataResponse
newPutRepositoryCatalogDataResponse Int
pHttpStatus_ =
  PutRepositoryCatalogDataResponse'
    { $sel:catalogData:PutRepositoryCatalogDataResponse' :: Maybe RepositoryCatalogData
catalogData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutRepositoryCatalogDataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The catalog data for the repository.
putRepositoryCatalogDataResponse_catalogData :: Lens.Lens' PutRepositoryCatalogDataResponse (Prelude.Maybe RepositoryCatalogData)
putRepositoryCatalogDataResponse_catalogData :: Lens'
  PutRepositoryCatalogDataResponse (Maybe RepositoryCatalogData)
putRepositoryCatalogDataResponse_catalogData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRepositoryCatalogDataResponse' {Maybe RepositoryCatalogData
catalogData :: Maybe RepositoryCatalogData
$sel:catalogData:PutRepositoryCatalogDataResponse' :: PutRepositoryCatalogDataResponse -> Maybe RepositoryCatalogData
catalogData} -> Maybe RepositoryCatalogData
catalogData) (\s :: PutRepositoryCatalogDataResponse
s@PutRepositoryCatalogDataResponse' {} Maybe RepositoryCatalogData
a -> PutRepositoryCatalogDataResponse
s {$sel:catalogData:PutRepositoryCatalogDataResponse' :: Maybe RepositoryCatalogData
catalogData = Maybe RepositoryCatalogData
a} :: PutRepositoryCatalogDataResponse)

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

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