{-# 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.Evidently.UpdateProject
-- 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 the description of an existing project.
--
-- To create a new project, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_CreateProject.html CreateProject>.
--
-- Don\'t use this operation to update the data storage options of a
-- project. Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_UpdateProjectDataDelivery.html UpdateProjectDataDelivery>.
--
-- Don\'t use this operation to update the tags of a project. Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_TagResource.html TagResource>.
module Amazonka.Evidently.UpdateProject
  ( -- * Creating a Request
    UpdateProject (..),
    newUpdateProject,

    -- * Request Lenses
    updateProject_appConfigResource,
    updateProject_description,
    updateProject_project,

    -- * Destructuring the Response
    UpdateProjectResponse (..),
    newUpdateProjectResponse,

    -- * Response Lenses
    updateProjectResponse_httpStatus,
    updateProjectResponse_project,
  )
where

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

-- | /See:/ 'newUpdateProject' smart constructor.
data UpdateProject = UpdateProject'
  { -- | Use this parameter if the project will use client-side evaluation
    -- powered by AppConfig. Client-side evaluation allows your application to
    -- assign variations to user sessions locally instead of by calling the
    -- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
    -- operation. This mitigates the latency and availability risks that come
    -- with an API call. allows you to
    --
    -- This parameter is a structure that contains information about the
    -- AppConfig application that will be used for client-side evaluation.
    UpdateProject -> Maybe ProjectAppConfigResourceConfig
appConfigResource :: Prelude.Maybe ProjectAppConfigResourceConfig,
    -- | An optional description of the project.
    UpdateProject -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name or ARN of the project to update.
    UpdateProject -> Text
project :: Prelude.Text
  }
  deriving (UpdateProject -> UpdateProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProject -> UpdateProject -> Bool
$c/= :: UpdateProject -> UpdateProject -> Bool
== :: UpdateProject -> UpdateProject -> Bool
$c== :: UpdateProject -> UpdateProject -> Bool
Prelude.Eq, ReadPrec [UpdateProject]
ReadPrec UpdateProject
Int -> ReadS UpdateProject
ReadS [UpdateProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProject]
$creadListPrec :: ReadPrec [UpdateProject]
readPrec :: ReadPrec UpdateProject
$creadPrec :: ReadPrec UpdateProject
readList :: ReadS [UpdateProject]
$creadList :: ReadS [UpdateProject]
readsPrec :: Int -> ReadS UpdateProject
$creadsPrec :: Int -> ReadS UpdateProject
Prelude.Read, Int -> UpdateProject -> ShowS
[UpdateProject] -> ShowS
UpdateProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProject] -> ShowS
$cshowList :: [UpdateProject] -> ShowS
show :: UpdateProject -> String
$cshow :: UpdateProject -> String
showsPrec :: Int -> UpdateProject -> ShowS
$cshowsPrec :: Int -> UpdateProject -> ShowS
Prelude.Show, forall x. Rep UpdateProject x -> UpdateProject
forall x. UpdateProject -> Rep UpdateProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateProject x -> UpdateProject
$cfrom :: forall x. UpdateProject -> Rep UpdateProject x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProject' 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:
--
-- 'appConfigResource', 'updateProject_appConfigResource' - Use this parameter if the project will use client-side evaluation
-- powered by AppConfig. Client-side evaluation allows your application to
-- assign variations to user sessions locally instead of by calling the
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
-- operation. This mitigates the latency and availability risks that come
-- with an API call. allows you to
--
-- This parameter is a structure that contains information about the
-- AppConfig application that will be used for client-side evaluation.
--
-- 'description', 'updateProject_description' - An optional description of the project.
--
-- 'project', 'updateProject_project' - The name or ARN of the project to update.
newUpdateProject ::
  -- | 'project'
  Prelude.Text ->
  UpdateProject
newUpdateProject :: Text -> UpdateProject
newUpdateProject Text
pProject_ =
  UpdateProject'
    { $sel:appConfigResource:UpdateProject' :: Maybe ProjectAppConfigResourceConfig
appConfigResource = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateProject' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:project:UpdateProject' :: Text
project = Text
pProject_
    }

-- | Use this parameter if the project will use client-side evaluation
-- powered by AppConfig. Client-side evaluation allows your application to
-- assign variations to user sessions locally instead of by calling the
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
-- operation. This mitigates the latency and availability risks that come
-- with an API call. allows you to
--
-- This parameter is a structure that contains information about the
-- AppConfig application that will be used for client-side evaluation.
updateProject_appConfigResource :: Lens.Lens' UpdateProject (Prelude.Maybe ProjectAppConfigResourceConfig)
updateProject_appConfigResource :: Lens' UpdateProject (Maybe ProjectAppConfigResourceConfig)
updateProject_appConfigResource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProject' {Maybe ProjectAppConfigResourceConfig
appConfigResource :: Maybe ProjectAppConfigResourceConfig
$sel:appConfigResource:UpdateProject' :: UpdateProject -> Maybe ProjectAppConfigResourceConfig
appConfigResource} -> Maybe ProjectAppConfigResourceConfig
appConfigResource) (\s :: UpdateProject
s@UpdateProject' {} Maybe ProjectAppConfigResourceConfig
a -> UpdateProject
s {$sel:appConfigResource:UpdateProject' :: Maybe ProjectAppConfigResourceConfig
appConfigResource = Maybe ProjectAppConfigResourceConfig
a} :: UpdateProject)

-- | An optional description of the project.
updateProject_description :: Lens.Lens' UpdateProject (Prelude.Maybe Prelude.Text)
updateProject_description :: Lens' UpdateProject (Maybe Text)
updateProject_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProject' {Maybe Text
description :: Maybe Text
$sel:description:UpdateProject' :: UpdateProject -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateProject
s@UpdateProject' {} Maybe Text
a -> UpdateProject
s {$sel:description:UpdateProject' :: Maybe Text
description = Maybe Text
a} :: UpdateProject)

-- | The name or ARN of the project to update.
updateProject_project :: Lens.Lens' UpdateProject Prelude.Text
updateProject_project :: Lens' UpdateProject Text
updateProject_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProject' {Text
project :: Text
$sel:project:UpdateProject' :: UpdateProject -> Text
project} -> Text
project) (\s :: UpdateProject
s@UpdateProject' {} Text
a -> UpdateProject
s {$sel:project:UpdateProject' :: Text
project = Text
a} :: UpdateProject)

instance Core.AWSRequest UpdateProject where
  type
    AWSResponse UpdateProject =
      UpdateProjectResponse
  request :: (Service -> Service) -> UpdateProject -> Request UpdateProject
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateProject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateProject)))
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 ->
          Int -> Project -> UpdateProjectResponse
UpdateProjectResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"project")
      )

instance Prelude.Hashable UpdateProject where
  hashWithSalt :: Int -> UpdateProject -> Int
hashWithSalt Int
_salt UpdateProject' {Maybe Text
Maybe ProjectAppConfigResourceConfig
Text
project :: Text
description :: Maybe Text
appConfigResource :: Maybe ProjectAppConfigResourceConfig
$sel:project:UpdateProject' :: UpdateProject -> Text
$sel:description:UpdateProject' :: UpdateProject -> Maybe Text
$sel:appConfigResource:UpdateProject' :: UpdateProject -> Maybe ProjectAppConfigResourceConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProjectAppConfigResourceConfig
appConfigResource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData UpdateProject where
  rnf :: UpdateProject -> ()
rnf UpdateProject' {Maybe Text
Maybe ProjectAppConfigResourceConfig
Text
project :: Text
description :: Maybe Text
appConfigResource :: Maybe ProjectAppConfigResourceConfig
$sel:project:UpdateProject' :: UpdateProject -> Text
$sel:description:UpdateProject' :: UpdateProject -> Maybe Text
$sel:appConfigResource:UpdateProject' :: UpdateProject -> Maybe ProjectAppConfigResourceConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProjectAppConfigResourceConfig
appConfigResource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders UpdateProject where
  toHeaders :: UpdateProject -> 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 UpdateProject where
  toJSON :: UpdateProject -> Value
toJSON UpdateProject' {Maybe Text
Maybe ProjectAppConfigResourceConfig
Text
project :: Text
description :: Maybe Text
appConfigResource :: Maybe ProjectAppConfigResourceConfig
$sel:project:UpdateProject' :: UpdateProject -> Text
$sel:description:UpdateProject' :: UpdateProject -> Maybe Text
$sel:appConfigResource:UpdateProject' :: UpdateProject -> Maybe ProjectAppConfigResourceConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"appConfigResource" 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 ProjectAppConfigResourceConfig
appConfigResource,
            (Key
"description" 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
description
          ]
      )

instance Data.ToPath UpdateProject where
  toPath :: UpdateProject -> ByteString
toPath UpdateProject' {Maybe Text
Maybe ProjectAppConfigResourceConfig
Text
project :: Text
description :: Maybe Text
appConfigResource :: Maybe ProjectAppConfigResourceConfig
$sel:project:UpdateProject' :: UpdateProject -> Text
$sel:description:UpdateProject' :: UpdateProject -> Maybe Text
$sel:appConfigResource:UpdateProject' :: UpdateProject -> Maybe ProjectAppConfigResourceConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
project]

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

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

-- |
-- Create a value of 'UpdateProjectResponse' 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', 'updateProjectResponse_httpStatus' - The response's http status code.
--
-- 'project', 'updateProjectResponse_project' - A structure containing information about the updated project.
newUpdateProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'project'
  Project ->
  UpdateProjectResponse
newUpdateProjectResponse :: Int -> Project -> UpdateProjectResponse
newUpdateProjectResponse Int
pHttpStatus_ Project
pProject_ =
  UpdateProjectResponse'
    { $sel:httpStatus:UpdateProjectResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:project:UpdateProjectResponse' :: Project
project = Project
pProject_
    }

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

-- | A structure containing information about the updated project.
updateProjectResponse_project :: Lens.Lens' UpdateProjectResponse Project
updateProjectResponse_project :: Lens' UpdateProjectResponse Project
updateProjectResponse_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectResponse' {Project
project :: Project
$sel:project:UpdateProjectResponse' :: UpdateProjectResponse -> Project
project} -> Project
project) (\s :: UpdateProjectResponse
s@UpdateProjectResponse' {} Project
a -> UpdateProjectResponse
s {$sel:project:UpdateProjectResponse' :: Project
project = Project
a} :: UpdateProjectResponse)

instance Prelude.NFData UpdateProjectResponse where
  rnf :: UpdateProjectResponse -> ()
rnf UpdateProjectResponse' {Int
Project
project :: Project
httpStatus :: Int
$sel:project:UpdateProjectResponse' :: UpdateProjectResponse -> Project
$sel:httpStatus:UpdateProjectResponse' :: UpdateProjectResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Project
project