{-# 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.CodeArtifact.PutPackageOriginConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the package origin configuration for a package.
--
-- The package origin configuration determines how new versions of a
-- package can be added to a repository. You can allow or block direct
-- publishing of new package versions, or ingestion and retaining of new
-- package versions from an external connection or upstream source. For
-- more information about package origin controls and configuration, see
-- <https://docs.aws.amazon.com/codeartifact/latest/ug/package-origin-controls.html Editing package origin controls>
-- in the /CodeArtifact User Guide/.
--
-- @PutPackageOriginConfiguration@ can be called on a package that doesn\'t
-- yet exist in the repository. When called on a package that does not
-- exist, a package is created in the repository with no versions and the
-- requested restrictions are set on the package. This can be used to
-- preemptively block ingesting or retaining any versions from external
-- connections or upstream repositories, or to block publishing any
-- versions of the package into the repository before connecting any
-- package managers or publishers to the repository.
module Amazonka.CodeArtifact.PutPackageOriginConfiguration
  ( -- * Creating a Request
    PutPackageOriginConfiguration (..),
    newPutPackageOriginConfiguration,

    -- * Request Lenses
    putPackageOriginConfiguration_domainOwner,
    putPackageOriginConfiguration_namespace,
    putPackageOriginConfiguration_domain,
    putPackageOriginConfiguration_repository,
    putPackageOriginConfiguration_format,
    putPackageOriginConfiguration_package,
    putPackageOriginConfiguration_restrictions,

    -- * Destructuring the Response
    PutPackageOriginConfigurationResponse (..),
    newPutPackageOriginConfigurationResponse,

    -- * Response Lenses
    putPackageOriginConfigurationResponse_originConfiguration,
    putPackageOriginConfigurationResponse_httpStatus,
  )
where

import Amazonka.CodeArtifact.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

-- | /See:/ 'newPutPackageOriginConfiguration' smart constructor.
data PutPackageOriginConfiguration = PutPackageOriginConfiguration'
  { -- | The 12-digit account number of the Amazon Web Services account that owns
    -- the domain. It does not include dashes or spaces.
    PutPackageOriginConfiguration -> Maybe Text
domainOwner :: Prelude.Maybe Prelude.Text,
    -- | The namespace of the package to be updated. The package component that
    -- specifies its namespace depends on its type. For example:
    --
    -- -   The namespace of a Maven package is its @groupId@.
    --
    -- -   The namespace of an npm package is its @scope@.
    --
    -- -   Python and NuGet packages do not contain a corresponding component,
    --     packages of those formats do not have a namespace.
    PutPackageOriginConfiguration -> Maybe Text
namespace :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain that contains the repository that contains the
    -- package.
    PutPackageOriginConfiguration -> Text
domain :: Prelude.Text,
    -- | The name of the repository that contains the package.
    PutPackageOriginConfiguration -> Text
repository :: Prelude.Text,
    -- | A format that specifies the type of the package to be updated.
    PutPackageOriginConfiguration -> PackageFormat
format :: PackageFormat,
    -- | The name of the package to be updated.
    PutPackageOriginConfiguration -> Text
package :: Prelude.Text,
    -- | A
    -- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
    -- object that contains information about the @upstream@ and @publish@
    -- package origin restrictions. The @upstream@ restriction determines if
    -- new package versions can be ingested or retained from external
    -- connections or upstream repositories. The @publish@ restriction
    -- determines if new package versions can be published directly to the
    -- repository.
    --
    -- You must include both the desired @upstream@ and @publish@ restrictions.
    PutPackageOriginConfiguration -> PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
  }
  deriving (PutPackageOriginConfiguration
-> PutPackageOriginConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutPackageOriginConfiguration
-> PutPackageOriginConfiguration -> Bool
$c/= :: PutPackageOriginConfiguration
-> PutPackageOriginConfiguration -> Bool
== :: PutPackageOriginConfiguration
-> PutPackageOriginConfiguration -> Bool
$c== :: PutPackageOriginConfiguration
-> PutPackageOriginConfiguration -> Bool
Prelude.Eq, ReadPrec [PutPackageOriginConfiguration]
ReadPrec PutPackageOriginConfiguration
Int -> ReadS PutPackageOriginConfiguration
ReadS [PutPackageOriginConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutPackageOriginConfiguration]
$creadListPrec :: ReadPrec [PutPackageOriginConfiguration]
readPrec :: ReadPrec PutPackageOriginConfiguration
$creadPrec :: ReadPrec PutPackageOriginConfiguration
readList :: ReadS [PutPackageOriginConfiguration]
$creadList :: ReadS [PutPackageOriginConfiguration]
readsPrec :: Int -> ReadS PutPackageOriginConfiguration
$creadsPrec :: Int -> ReadS PutPackageOriginConfiguration
Prelude.Read, Int -> PutPackageOriginConfiguration -> ShowS
[PutPackageOriginConfiguration] -> ShowS
PutPackageOriginConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutPackageOriginConfiguration] -> ShowS
$cshowList :: [PutPackageOriginConfiguration] -> ShowS
show :: PutPackageOriginConfiguration -> String
$cshow :: PutPackageOriginConfiguration -> String
showsPrec :: Int -> PutPackageOriginConfiguration -> ShowS
$cshowsPrec :: Int -> PutPackageOriginConfiguration -> ShowS
Prelude.Show, forall x.
Rep PutPackageOriginConfiguration x
-> PutPackageOriginConfiguration
forall x.
PutPackageOriginConfiguration
-> Rep PutPackageOriginConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutPackageOriginConfiguration x
-> PutPackageOriginConfiguration
$cfrom :: forall x.
PutPackageOriginConfiguration
-> Rep PutPackageOriginConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutPackageOriginConfiguration' 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:
--
-- 'domainOwner', 'putPackageOriginConfiguration_domainOwner' - The 12-digit account number of the Amazon Web Services account that owns
-- the domain. It does not include dashes or spaces.
--
-- 'namespace', 'putPackageOriginConfiguration_namespace' - The namespace of the package to be updated. The package component that
-- specifies its namespace depends on its type. For example:
--
-- -   The namespace of a Maven package is its @groupId@.
--
-- -   The namespace of an npm package is its @scope@.
--
-- -   Python and NuGet packages do not contain a corresponding component,
--     packages of those formats do not have a namespace.
--
-- 'domain', 'putPackageOriginConfiguration_domain' - The name of the domain that contains the repository that contains the
-- package.
--
-- 'repository', 'putPackageOriginConfiguration_repository' - The name of the repository that contains the package.
--
-- 'format', 'putPackageOriginConfiguration_format' - A format that specifies the type of the package to be updated.
--
-- 'package', 'putPackageOriginConfiguration_package' - The name of the package to be updated.
--
-- 'restrictions', 'putPackageOriginConfiguration_restrictions' - A
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
-- object that contains information about the @upstream@ and @publish@
-- package origin restrictions. The @upstream@ restriction determines if
-- new package versions can be ingested or retained from external
-- connections or upstream repositories. The @publish@ restriction
-- determines if new package versions can be published directly to the
-- repository.
--
-- You must include both the desired @upstream@ and @publish@ restrictions.
newPutPackageOriginConfiguration ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'repository'
  Prelude.Text ->
  -- | 'format'
  PackageFormat ->
  -- | 'package'
  Prelude.Text ->
  -- | 'restrictions'
  PackageOriginRestrictions ->
  PutPackageOriginConfiguration
newPutPackageOriginConfiguration :: Text
-> Text
-> PackageFormat
-> Text
-> PackageOriginRestrictions
-> PutPackageOriginConfiguration
newPutPackageOriginConfiguration
  Text
pDomain_
  Text
pRepository_
  PackageFormat
pFormat_
  Text
pPackage_
  PackageOriginRestrictions
pRestrictions_ =
    PutPackageOriginConfiguration'
      { $sel:domainOwner:PutPackageOriginConfiguration' :: Maybe Text
domainOwner =
          forall a. Maybe a
Prelude.Nothing,
        $sel:namespace:PutPackageOriginConfiguration' :: Maybe Text
namespace = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:PutPackageOriginConfiguration' :: Text
domain = Text
pDomain_,
        $sel:repository:PutPackageOriginConfiguration' :: Text
repository = Text
pRepository_,
        $sel:format:PutPackageOriginConfiguration' :: PackageFormat
format = PackageFormat
pFormat_,
        $sel:package:PutPackageOriginConfiguration' :: Text
package = Text
pPackage_,
        $sel:restrictions:PutPackageOriginConfiguration' :: PackageOriginRestrictions
restrictions = PackageOriginRestrictions
pRestrictions_
      }

-- | The 12-digit account number of the Amazon Web Services account that owns
-- the domain. It does not include dashes or spaces.
putPackageOriginConfiguration_domainOwner :: Lens.Lens' PutPackageOriginConfiguration (Prelude.Maybe Prelude.Text)
putPackageOriginConfiguration_domainOwner :: Lens' PutPackageOriginConfiguration (Maybe Text)
putPackageOriginConfiguration_domainOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {Maybe Text
domainOwner :: Maybe Text
$sel:domainOwner:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
domainOwner} -> Maybe Text
domainOwner) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} Maybe Text
a -> PutPackageOriginConfiguration
s {$sel:domainOwner:PutPackageOriginConfiguration' :: Maybe Text
domainOwner = Maybe Text
a} :: PutPackageOriginConfiguration)

-- | The namespace of the package to be updated. The package component that
-- specifies its namespace depends on its type. For example:
--
-- -   The namespace of a Maven package is its @groupId@.
--
-- -   The namespace of an npm package is its @scope@.
--
-- -   Python and NuGet packages do not contain a corresponding component,
--     packages of those formats do not have a namespace.
putPackageOriginConfiguration_namespace :: Lens.Lens' PutPackageOriginConfiguration (Prelude.Maybe Prelude.Text)
putPackageOriginConfiguration_namespace :: Lens' PutPackageOriginConfiguration (Maybe Text)
putPackageOriginConfiguration_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {Maybe Text
namespace :: Maybe Text
$sel:namespace:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
namespace} -> Maybe Text
namespace) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} Maybe Text
a -> PutPackageOriginConfiguration
s {$sel:namespace:PutPackageOriginConfiguration' :: Maybe Text
namespace = Maybe Text
a} :: PutPackageOriginConfiguration)

-- | The name of the domain that contains the repository that contains the
-- package.
putPackageOriginConfiguration_domain :: Lens.Lens' PutPackageOriginConfiguration Prelude.Text
putPackageOriginConfiguration_domain :: Lens' PutPackageOriginConfiguration Text
putPackageOriginConfiguration_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {Text
domain :: Text
$sel:domain:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
domain} -> Text
domain) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} Text
a -> PutPackageOriginConfiguration
s {$sel:domain:PutPackageOriginConfiguration' :: Text
domain = Text
a} :: PutPackageOriginConfiguration)

-- | The name of the repository that contains the package.
putPackageOriginConfiguration_repository :: Lens.Lens' PutPackageOriginConfiguration Prelude.Text
putPackageOriginConfiguration_repository :: Lens' PutPackageOriginConfiguration Text
putPackageOriginConfiguration_repository = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {Text
repository :: Text
$sel:repository:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
repository} -> Text
repository) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} Text
a -> PutPackageOriginConfiguration
s {$sel:repository:PutPackageOriginConfiguration' :: Text
repository = Text
a} :: PutPackageOriginConfiguration)

-- | A format that specifies the type of the package to be updated.
putPackageOriginConfiguration_format :: Lens.Lens' PutPackageOriginConfiguration PackageFormat
putPackageOriginConfiguration_format :: Lens' PutPackageOriginConfiguration PackageFormat
putPackageOriginConfiguration_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {PackageFormat
format :: PackageFormat
$sel:format:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageFormat
format} -> PackageFormat
format) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} PackageFormat
a -> PutPackageOriginConfiguration
s {$sel:format:PutPackageOriginConfiguration' :: PackageFormat
format = PackageFormat
a} :: PutPackageOriginConfiguration)

-- | The name of the package to be updated.
putPackageOriginConfiguration_package :: Lens.Lens' PutPackageOriginConfiguration Prelude.Text
putPackageOriginConfiguration_package :: Lens' PutPackageOriginConfiguration Text
putPackageOriginConfiguration_package = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {Text
package :: Text
$sel:package:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
package} -> Text
package) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} Text
a -> PutPackageOriginConfiguration
s {$sel:package:PutPackageOriginConfiguration' :: Text
package = Text
a} :: PutPackageOriginConfiguration)

-- | A
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
-- object that contains information about the @upstream@ and @publish@
-- package origin restrictions. The @upstream@ restriction determines if
-- new package versions can be ingested or retained from external
-- connections or upstream repositories. The @publish@ restriction
-- determines if new package versions can be published directly to the
-- repository.
--
-- You must include both the desired @upstream@ and @publish@ restrictions.
putPackageOriginConfiguration_restrictions :: Lens.Lens' PutPackageOriginConfiguration PackageOriginRestrictions
putPackageOriginConfiguration_restrictions :: Lens' PutPackageOriginConfiguration PackageOriginRestrictions
putPackageOriginConfiguration_restrictions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfiguration' {PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
$sel:restrictions:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageOriginRestrictions
restrictions} -> PackageOriginRestrictions
restrictions) (\s :: PutPackageOriginConfiguration
s@PutPackageOriginConfiguration' {} PackageOriginRestrictions
a -> PutPackageOriginConfiguration
s {$sel:restrictions:PutPackageOriginConfiguration' :: PackageOriginRestrictions
restrictions = PackageOriginRestrictions
a} :: PutPackageOriginConfiguration)

instance
  Core.AWSRequest
    PutPackageOriginConfiguration
  where
  type
    AWSResponse PutPackageOriginConfiguration =
      PutPackageOriginConfigurationResponse
  request :: (Service -> Service)
-> PutPackageOriginConfiguration
-> Request PutPackageOriginConfiguration
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 PutPackageOriginConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutPackageOriginConfiguration)))
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 PackageOriginConfiguration
-> Int -> PutPackageOriginConfigurationResponse
PutPackageOriginConfigurationResponse'
            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
"originConfiguration")
            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
    PutPackageOriginConfiguration
  where
  hashWithSalt :: Int -> PutPackageOriginConfiguration -> Int
hashWithSalt Int
_salt PutPackageOriginConfiguration' {Maybe Text
Text
PackageFormat
PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
package :: Text
format :: PackageFormat
repository :: Text
domain :: Text
namespace :: Maybe Text
domainOwner :: Maybe Text
$sel:restrictions:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageOriginRestrictions
$sel:package:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:format:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageFormat
$sel:repository:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:domain:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:namespace:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
$sel:domainOwner:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repository
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PackageFormat
format
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
package
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PackageOriginRestrictions
restrictions

instance Prelude.NFData PutPackageOriginConfiguration where
  rnf :: PutPackageOriginConfiguration -> ()
rnf PutPackageOriginConfiguration' {Maybe Text
Text
PackageFormat
PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
package :: Text
format :: PackageFormat
repository :: Text
domain :: Text
namespace :: Maybe Text
domainOwner :: Maybe Text
$sel:restrictions:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageOriginRestrictions
$sel:package:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:format:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageFormat
$sel:repository:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:domain:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:namespace:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
$sel:domainOwner:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repository
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PackageFormat
format
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
package
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PackageOriginRestrictions
restrictions

instance Data.ToHeaders PutPackageOriginConfiguration where
  toHeaders :: PutPackageOriginConfiguration -> 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 PutPackageOriginConfiguration where
  toJSON :: PutPackageOriginConfiguration -> Value
toJSON PutPackageOriginConfiguration' {Maybe Text
Text
PackageFormat
PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
package :: Text
format :: PackageFormat
repository :: Text
domain :: Text
namespace :: Maybe Text
domainOwner :: Maybe Text
$sel:restrictions:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageOriginRestrictions
$sel:package:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:format:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageFormat
$sel:repository:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:domain:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:namespace:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
$sel:domainOwner:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"restrictions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PackageOriginRestrictions
restrictions)]
      )

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

instance Data.ToQuery PutPackageOriginConfiguration where
  toQuery :: PutPackageOriginConfiguration -> QueryString
toQuery PutPackageOriginConfiguration' {Maybe Text
Text
PackageFormat
PackageOriginRestrictions
restrictions :: PackageOriginRestrictions
package :: Text
format :: PackageFormat
repository :: Text
domain :: Text
namespace :: Maybe Text
domainOwner :: Maybe Text
$sel:restrictions:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageOriginRestrictions
$sel:package:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:format:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> PackageFormat
$sel:repository:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:domain:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Text
$sel:namespace:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
$sel:domainOwner:PutPackageOriginConfiguration' :: PutPackageOriginConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"domain-owner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
domainOwner,
        ByteString
"namespace" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespace,
        ByteString
"domain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domain,
        ByteString
"repository" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
repository,
        ByteString
"format" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: PackageFormat
format,
        ByteString
"package" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
package
      ]

-- | /See:/ 'newPutPackageOriginConfigurationResponse' smart constructor.
data PutPackageOriginConfigurationResponse = PutPackageOriginConfigurationResponse'
  { -- | A
    -- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginConfiguration.html PackageOriginConfiguration>
    -- object that describes the origin configuration set for the package. It
    -- contains a
    -- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
    -- object that describes how new versions of the package can be introduced
    -- to the repository.
    PutPackageOriginConfigurationResponse
-> Maybe PackageOriginConfiguration
originConfiguration :: Prelude.Maybe PackageOriginConfiguration,
    -- | The response's http status code.
    PutPackageOriginConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutPackageOriginConfigurationResponse
-> PutPackageOriginConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutPackageOriginConfigurationResponse
-> PutPackageOriginConfigurationResponse -> Bool
$c/= :: PutPackageOriginConfigurationResponse
-> PutPackageOriginConfigurationResponse -> Bool
== :: PutPackageOriginConfigurationResponse
-> PutPackageOriginConfigurationResponse -> Bool
$c== :: PutPackageOriginConfigurationResponse
-> PutPackageOriginConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [PutPackageOriginConfigurationResponse]
ReadPrec PutPackageOriginConfigurationResponse
Int -> ReadS PutPackageOriginConfigurationResponse
ReadS [PutPackageOriginConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutPackageOriginConfigurationResponse]
$creadListPrec :: ReadPrec [PutPackageOriginConfigurationResponse]
readPrec :: ReadPrec PutPackageOriginConfigurationResponse
$creadPrec :: ReadPrec PutPackageOriginConfigurationResponse
readList :: ReadS [PutPackageOriginConfigurationResponse]
$creadList :: ReadS [PutPackageOriginConfigurationResponse]
readsPrec :: Int -> ReadS PutPackageOriginConfigurationResponse
$creadsPrec :: Int -> ReadS PutPackageOriginConfigurationResponse
Prelude.Read, Int -> PutPackageOriginConfigurationResponse -> ShowS
[PutPackageOriginConfigurationResponse] -> ShowS
PutPackageOriginConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutPackageOriginConfigurationResponse] -> ShowS
$cshowList :: [PutPackageOriginConfigurationResponse] -> ShowS
show :: PutPackageOriginConfigurationResponse -> String
$cshow :: PutPackageOriginConfigurationResponse -> String
showsPrec :: Int -> PutPackageOriginConfigurationResponse -> ShowS
$cshowsPrec :: Int -> PutPackageOriginConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep PutPackageOriginConfigurationResponse x
-> PutPackageOriginConfigurationResponse
forall x.
PutPackageOriginConfigurationResponse
-> Rep PutPackageOriginConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutPackageOriginConfigurationResponse x
-> PutPackageOriginConfigurationResponse
$cfrom :: forall x.
PutPackageOriginConfigurationResponse
-> Rep PutPackageOriginConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutPackageOriginConfigurationResponse' 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:
--
-- 'originConfiguration', 'putPackageOriginConfigurationResponse_originConfiguration' - A
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginConfiguration.html PackageOriginConfiguration>
-- object that describes the origin configuration set for the package. It
-- contains a
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
-- object that describes how new versions of the package can be introduced
-- to the repository.
--
-- 'httpStatus', 'putPackageOriginConfigurationResponse_httpStatus' - The response's http status code.
newPutPackageOriginConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutPackageOriginConfigurationResponse
newPutPackageOriginConfigurationResponse :: Int -> PutPackageOriginConfigurationResponse
newPutPackageOriginConfigurationResponse Int
pHttpStatus_ =
  PutPackageOriginConfigurationResponse'
    { $sel:originConfiguration:PutPackageOriginConfigurationResponse' :: Maybe PackageOriginConfiguration
originConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutPackageOriginConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginConfiguration.html PackageOriginConfiguration>
-- object that describes the origin configuration set for the package. It
-- contains a
-- <https://docs.aws.amazon.com/codeartifact/latest/APIReference/API_PackageOriginRestrictions.html PackageOriginRestrictions>
-- object that describes how new versions of the package can be introduced
-- to the repository.
putPackageOriginConfigurationResponse_originConfiguration :: Lens.Lens' PutPackageOriginConfigurationResponse (Prelude.Maybe PackageOriginConfiguration)
putPackageOriginConfigurationResponse_originConfiguration :: Lens'
  PutPackageOriginConfigurationResponse
  (Maybe PackageOriginConfiguration)
putPackageOriginConfigurationResponse_originConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPackageOriginConfigurationResponse' {Maybe PackageOriginConfiguration
originConfiguration :: Maybe PackageOriginConfiguration
$sel:originConfiguration:PutPackageOriginConfigurationResponse' :: PutPackageOriginConfigurationResponse
-> Maybe PackageOriginConfiguration
originConfiguration} -> Maybe PackageOriginConfiguration
originConfiguration) (\s :: PutPackageOriginConfigurationResponse
s@PutPackageOriginConfigurationResponse' {} Maybe PackageOriginConfiguration
a -> PutPackageOriginConfigurationResponse
s {$sel:originConfiguration:PutPackageOriginConfigurationResponse' :: Maybe PackageOriginConfiguration
originConfiguration = Maybe PackageOriginConfiguration
a} :: PutPackageOriginConfigurationResponse)

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

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