{-# 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.OpenSearch.UpdatePackage
-- 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 a package for use with Amazon OpenSearch Service domains. For
-- more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/custom-packages.html Custom packages for Amazon OpenSearch Service>.
module Amazonka.OpenSearch.UpdatePackage
  ( -- * Creating a Request
    UpdatePackage (..),
    newUpdatePackage,

    -- * Request Lenses
    updatePackage_commitMessage,
    updatePackage_packageDescription,
    updatePackage_packageID,
    updatePackage_packageSource,

    -- * Destructuring the Response
    UpdatePackageResponse (..),
    newUpdatePackageResponse,

    -- * Response Lenses
    updatePackageResponse_packageDetails,
    updatePackageResponse_httpStatus,
  )
where

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

-- | Container for request parameters to the @UpdatePackage@ operation.
--
-- /See:/ 'newUpdatePackage' smart constructor.
data UpdatePackage = UpdatePackage'
  { -- | Commit message for the updated file, which is shown as part of
    -- @GetPackageVersionHistoryResponse@.
    UpdatePackage -> Maybe Text
commitMessage :: Prelude.Maybe Prelude.Text,
    -- | A new description of the package.
    UpdatePackage -> Maybe Text
packageDescription :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the package.
    UpdatePackage -> Text
packageID :: Prelude.Text,
    -- | Amazon S3 bucket and key for the package.
    UpdatePackage -> PackageSource
packageSource :: PackageSource
  }
  deriving (UpdatePackage -> UpdatePackage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePackage -> UpdatePackage -> Bool
$c/= :: UpdatePackage -> UpdatePackage -> Bool
== :: UpdatePackage -> UpdatePackage -> Bool
$c== :: UpdatePackage -> UpdatePackage -> Bool
Prelude.Eq, ReadPrec [UpdatePackage]
ReadPrec UpdatePackage
Int -> ReadS UpdatePackage
ReadS [UpdatePackage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePackage]
$creadListPrec :: ReadPrec [UpdatePackage]
readPrec :: ReadPrec UpdatePackage
$creadPrec :: ReadPrec UpdatePackage
readList :: ReadS [UpdatePackage]
$creadList :: ReadS [UpdatePackage]
readsPrec :: Int -> ReadS UpdatePackage
$creadsPrec :: Int -> ReadS UpdatePackage
Prelude.Read, Int -> UpdatePackage -> ShowS
[UpdatePackage] -> ShowS
UpdatePackage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePackage] -> ShowS
$cshowList :: [UpdatePackage] -> ShowS
show :: UpdatePackage -> String
$cshow :: UpdatePackage -> String
showsPrec :: Int -> UpdatePackage -> ShowS
$cshowsPrec :: Int -> UpdatePackage -> ShowS
Prelude.Show, forall x. Rep UpdatePackage x -> UpdatePackage
forall x. UpdatePackage -> Rep UpdatePackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePackage x -> UpdatePackage
$cfrom :: forall x. UpdatePackage -> Rep UpdatePackage x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePackage' 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:
--
-- 'commitMessage', 'updatePackage_commitMessage' - Commit message for the updated file, which is shown as part of
-- @GetPackageVersionHistoryResponse@.
--
-- 'packageDescription', 'updatePackage_packageDescription' - A new description of the package.
--
-- 'packageID', 'updatePackage_packageID' - The unique identifier for the package.
--
-- 'packageSource', 'updatePackage_packageSource' - Amazon S3 bucket and key for the package.
newUpdatePackage ::
  -- | 'packageID'
  Prelude.Text ->
  -- | 'packageSource'
  PackageSource ->
  UpdatePackage
newUpdatePackage :: Text -> PackageSource -> UpdatePackage
newUpdatePackage Text
pPackageID_ PackageSource
pPackageSource_ =
  UpdatePackage'
    { $sel:commitMessage:UpdatePackage' :: Maybe Text
commitMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:packageDescription:UpdatePackage' :: Maybe Text
packageDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:packageID:UpdatePackage' :: Text
packageID = Text
pPackageID_,
      $sel:packageSource:UpdatePackage' :: PackageSource
packageSource = PackageSource
pPackageSource_
    }

-- | Commit message for the updated file, which is shown as part of
-- @GetPackageVersionHistoryResponse@.
updatePackage_commitMessage :: Lens.Lens' UpdatePackage (Prelude.Maybe Prelude.Text)
updatePackage_commitMessage :: Lens' UpdatePackage (Maybe Text)
updatePackage_commitMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePackage' {Maybe Text
commitMessage :: Maybe Text
$sel:commitMessage:UpdatePackage' :: UpdatePackage -> Maybe Text
commitMessage} -> Maybe Text
commitMessage) (\s :: UpdatePackage
s@UpdatePackage' {} Maybe Text
a -> UpdatePackage
s {$sel:commitMessage:UpdatePackage' :: Maybe Text
commitMessage = Maybe Text
a} :: UpdatePackage)

-- | A new description of the package.
updatePackage_packageDescription :: Lens.Lens' UpdatePackage (Prelude.Maybe Prelude.Text)
updatePackage_packageDescription :: Lens' UpdatePackage (Maybe Text)
updatePackage_packageDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePackage' {Maybe Text
packageDescription :: Maybe Text
$sel:packageDescription:UpdatePackage' :: UpdatePackage -> Maybe Text
packageDescription} -> Maybe Text
packageDescription) (\s :: UpdatePackage
s@UpdatePackage' {} Maybe Text
a -> UpdatePackage
s {$sel:packageDescription:UpdatePackage' :: Maybe Text
packageDescription = Maybe Text
a} :: UpdatePackage)

-- | The unique identifier for the package.
updatePackage_packageID :: Lens.Lens' UpdatePackage Prelude.Text
updatePackage_packageID :: Lens' UpdatePackage Text
updatePackage_packageID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePackage' {Text
packageID :: Text
$sel:packageID:UpdatePackage' :: UpdatePackage -> Text
packageID} -> Text
packageID) (\s :: UpdatePackage
s@UpdatePackage' {} Text
a -> UpdatePackage
s {$sel:packageID:UpdatePackage' :: Text
packageID = Text
a} :: UpdatePackage)

-- | Amazon S3 bucket and key for the package.
updatePackage_packageSource :: Lens.Lens' UpdatePackage PackageSource
updatePackage_packageSource :: Lens' UpdatePackage PackageSource
updatePackage_packageSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePackage' {PackageSource
packageSource :: PackageSource
$sel:packageSource:UpdatePackage' :: UpdatePackage -> PackageSource
packageSource} -> PackageSource
packageSource) (\s :: UpdatePackage
s@UpdatePackage' {} PackageSource
a -> UpdatePackage
s {$sel:packageSource:UpdatePackage' :: PackageSource
packageSource = PackageSource
a} :: UpdatePackage)

instance Core.AWSRequest UpdatePackage where
  type
    AWSResponse UpdatePackage =
      UpdatePackageResponse
  request :: (Service -> Service) -> UpdatePackage -> Request UpdatePackage
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 UpdatePackage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePackage)))
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 PackageDetails -> Int -> UpdatePackageResponse
UpdatePackageResponse'
            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
"PackageDetails")
            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 UpdatePackage where
  hashWithSalt :: Int -> UpdatePackage -> Int
hashWithSalt Int
_salt UpdatePackage' {Maybe Text
Text
PackageSource
packageSource :: PackageSource
packageID :: Text
packageDescription :: Maybe Text
commitMessage :: Maybe Text
$sel:packageSource:UpdatePackage' :: UpdatePackage -> PackageSource
$sel:packageID:UpdatePackage' :: UpdatePackage -> Text
$sel:packageDescription:UpdatePackage' :: UpdatePackage -> Maybe Text
$sel:commitMessage:UpdatePackage' :: UpdatePackage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commitMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
packageDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
packageID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PackageSource
packageSource

instance Prelude.NFData UpdatePackage where
  rnf :: UpdatePackage -> ()
rnf UpdatePackage' {Maybe Text
Text
PackageSource
packageSource :: PackageSource
packageID :: Text
packageDescription :: Maybe Text
commitMessage :: Maybe Text
$sel:packageSource:UpdatePackage' :: UpdatePackage -> PackageSource
$sel:packageID:UpdatePackage' :: UpdatePackage -> Text
$sel:packageDescription:UpdatePackage' :: UpdatePackage -> Maybe Text
$sel:commitMessage:UpdatePackage' :: UpdatePackage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
commitMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
packageDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
packageID
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PackageSource
packageSource

instance Data.ToHeaders UpdatePackage where
  toHeaders :: UpdatePackage -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdatePackage where
  toJSON :: UpdatePackage -> Value
toJSON UpdatePackage' {Maybe Text
Text
PackageSource
packageSource :: PackageSource
packageID :: Text
packageDescription :: Maybe Text
commitMessage :: Maybe Text
$sel:packageSource:UpdatePackage' :: UpdatePackage -> PackageSource
$sel:packageID:UpdatePackage' :: UpdatePackage -> Text
$sel:packageDescription:UpdatePackage' :: UpdatePackage -> Maybe Text
$sel:commitMessage:UpdatePackage' :: UpdatePackage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CommitMessage" 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
commitMessage,
            (Key
"PackageDescription" 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
packageDescription,
            forall a. a -> Maybe a
Prelude.Just (Key
"PackageID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
packageID),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PackageSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PackageSource
packageSource)
          ]
      )

instance Data.ToPath UpdatePackage where
  toPath :: UpdatePackage -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2021-01-01/packages/update"

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

-- | Container for the response returned by the @UpdatePackage@ operation.
--
-- /See:/ 'newUpdatePackageResponse' smart constructor.
data UpdatePackageResponse = UpdatePackageResponse'
  { -- | Information about a package.
    UpdatePackageResponse -> Maybe PackageDetails
packageDetails :: Prelude.Maybe PackageDetails,
    -- | The response's http status code.
    UpdatePackageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePackageResponse -> UpdatePackageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePackageResponse -> UpdatePackageResponse -> Bool
$c/= :: UpdatePackageResponse -> UpdatePackageResponse -> Bool
== :: UpdatePackageResponse -> UpdatePackageResponse -> Bool
$c== :: UpdatePackageResponse -> UpdatePackageResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePackageResponse]
ReadPrec UpdatePackageResponse
Int -> ReadS UpdatePackageResponse
ReadS [UpdatePackageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePackageResponse]
$creadListPrec :: ReadPrec [UpdatePackageResponse]
readPrec :: ReadPrec UpdatePackageResponse
$creadPrec :: ReadPrec UpdatePackageResponse
readList :: ReadS [UpdatePackageResponse]
$creadList :: ReadS [UpdatePackageResponse]
readsPrec :: Int -> ReadS UpdatePackageResponse
$creadsPrec :: Int -> ReadS UpdatePackageResponse
Prelude.Read, Int -> UpdatePackageResponse -> ShowS
[UpdatePackageResponse] -> ShowS
UpdatePackageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePackageResponse] -> ShowS
$cshowList :: [UpdatePackageResponse] -> ShowS
show :: UpdatePackageResponse -> String
$cshow :: UpdatePackageResponse -> String
showsPrec :: Int -> UpdatePackageResponse -> ShowS
$cshowsPrec :: Int -> UpdatePackageResponse -> ShowS
Prelude.Show, forall x. Rep UpdatePackageResponse x -> UpdatePackageResponse
forall x. UpdatePackageResponse -> Rep UpdatePackageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePackageResponse x -> UpdatePackageResponse
$cfrom :: forall x. UpdatePackageResponse -> Rep UpdatePackageResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePackageResponse' 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:
--
-- 'packageDetails', 'updatePackageResponse_packageDetails' - Information about a package.
--
-- 'httpStatus', 'updatePackageResponse_httpStatus' - The response's http status code.
newUpdatePackageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePackageResponse
newUpdatePackageResponse :: Int -> UpdatePackageResponse
newUpdatePackageResponse Int
pHttpStatus_ =
  UpdatePackageResponse'
    { $sel:packageDetails:UpdatePackageResponse' :: Maybe PackageDetails
packageDetails =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePackageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a package.
updatePackageResponse_packageDetails :: Lens.Lens' UpdatePackageResponse (Prelude.Maybe PackageDetails)
updatePackageResponse_packageDetails :: Lens' UpdatePackageResponse (Maybe PackageDetails)
updatePackageResponse_packageDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePackageResponse' {Maybe PackageDetails
packageDetails :: Maybe PackageDetails
$sel:packageDetails:UpdatePackageResponse' :: UpdatePackageResponse -> Maybe PackageDetails
packageDetails} -> Maybe PackageDetails
packageDetails) (\s :: UpdatePackageResponse
s@UpdatePackageResponse' {} Maybe PackageDetails
a -> UpdatePackageResponse
s {$sel:packageDetails:UpdatePackageResponse' :: Maybe PackageDetails
packageDetails = Maybe PackageDetails
a} :: UpdatePackageResponse)

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

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