{-# 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.Organizations.UpdatePolicy
-- 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 an existing policy with a new name, description, or content. If
-- you don\'t supply any parameter, that value remains unchanged. You
-- can\'t change a policy\'s type.
--
-- This operation can be called only from the organization\'s management
-- account.
module Amazonka.Organizations.UpdatePolicy
  ( -- * Creating a Request
    UpdatePolicy (..),
    newUpdatePolicy,

    -- * Request Lenses
    updatePolicy_content,
    updatePolicy_description,
    updatePolicy_name,
    updatePolicy_policyId,

    -- * Destructuring the Response
    UpdatePolicyResponse (..),
    newUpdatePolicyResponse,

    -- * Response Lenses
    updatePolicyResponse_policy,
    updatePolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdatePolicy' smart constructor.
data UpdatePolicy = UpdatePolicy'
  { -- | If provided, the new content for the policy. The text must be correctly
    -- formatted JSON that complies with the syntax for the policy\'s type. For
    -- more information, see
    -- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_reference_scp-syntax.html Service Control Policy Syntax>
    -- in the /Organizations User Guide./
    UpdatePolicy -> Maybe Text
content :: Prelude.Maybe Prelude.Text,
    -- | If provided, the new description for the policy.
    UpdatePolicy -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | If provided, the new name for the policy.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
    -- validate this parameter is a string of any of the characters in the
    -- ASCII character range.
    UpdatePolicy -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier (ID) of the policy that you want to update.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
    -- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
    -- letters, digits, or the underscore character (_).
    UpdatePolicy -> Text
policyId :: Prelude.Text
  }
  deriving (UpdatePolicy -> UpdatePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePolicy -> UpdatePolicy -> Bool
$c/= :: UpdatePolicy -> UpdatePolicy -> Bool
== :: UpdatePolicy -> UpdatePolicy -> Bool
$c== :: UpdatePolicy -> UpdatePolicy -> Bool
Prelude.Eq, ReadPrec [UpdatePolicy]
ReadPrec UpdatePolicy
Int -> ReadS UpdatePolicy
ReadS [UpdatePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePolicy]
$creadListPrec :: ReadPrec [UpdatePolicy]
readPrec :: ReadPrec UpdatePolicy
$creadPrec :: ReadPrec UpdatePolicy
readList :: ReadS [UpdatePolicy]
$creadList :: ReadS [UpdatePolicy]
readsPrec :: Int -> ReadS UpdatePolicy
$creadsPrec :: Int -> ReadS UpdatePolicy
Prelude.Read, Int -> UpdatePolicy -> ShowS
[UpdatePolicy] -> ShowS
UpdatePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePolicy] -> ShowS
$cshowList :: [UpdatePolicy] -> ShowS
show :: UpdatePolicy -> String
$cshow :: UpdatePolicy -> String
showsPrec :: Int -> UpdatePolicy -> ShowS
$cshowsPrec :: Int -> UpdatePolicy -> ShowS
Prelude.Show, forall x. Rep UpdatePolicy x -> UpdatePolicy
forall x. UpdatePolicy -> Rep UpdatePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePolicy x -> UpdatePolicy
$cfrom :: forall x. UpdatePolicy -> Rep UpdatePolicy x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePolicy' 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:
--
-- 'content', 'updatePolicy_content' - If provided, the new content for the policy. The text must be correctly
-- formatted JSON that complies with the syntax for the policy\'s type. For
-- more information, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_reference_scp-syntax.html Service Control Policy Syntax>
-- in the /Organizations User Guide./
--
-- 'description', 'updatePolicy_description' - If provided, the new description for the policy.
--
-- 'name', 'updatePolicy_name' - If provided, the new name for the policy.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of any of the characters in the
-- ASCII character range.
--
-- 'policyId', 'updatePolicy_policyId' - The unique identifier (ID) of the policy that you want to update.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
-- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
-- letters, digits, or the underscore character (_).
newUpdatePolicy ::
  -- | 'policyId'
  Prelude.Text ->
  UpdatePolicy
newUpdatePolicy :: Text -> UpdatePolicy
newUpdatePolicy Text
pPolicyId_ =
  UpdatePolicy'
    { $sel:content:UpdatePolicy' :: Maybe Text
content = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdatePolicy' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdatePolicy' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:policyId:UpdatePolicy' :: Text
policyId = Text
pPolicyId_
    }

-- | If provided, the new content for the policy. The text must be correctly
-- formatted JSON that complies with the syntax for the policy\'s type. For
-- more information, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_reference_scp-syntax.html Service Control Policy Syntax>
-- in the /Organizations User Guide./
updatePolicy_content :: Lens.Lens' UpdatePolicy (Prelude.Maybe Prelude.Text)
updatePolicy_content :: Lens' UpdatePolicy (Maybe Text)
updatePolicy_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePolicy' {Maybe Text
content :: Maybe Text
$sel:content:UpdatePolicy' :: UpdatePolicy -> Maybe Text
content} -> Maybe Text
content) (\s :: UpdatePolicy
s@UpdatePolicy' {} Maybe Text
a -> UpdatePolicy
s {$sel:content:UpdatePolicy' :: Maybe Text
content = Maybe Text
a} :: UpdatePolicy)

-- | If provided, the new description for the policy.
updatePolicy_description :: Lens.Lens' UpdatePolicy (Prelude.Maybe Prelude.Text)
updatePolicy_description :: Lens' UpdatePolicy (Maybe Text)
updatePolicy_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePolicy' {Maybe Text
description :: Maybe Text
$sel:description:UpdatePolicy' :: UpdatePolicy -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdatePolicy
s@UpdatePolicy' {} Maybe Text
a -> UpdatePolicy
s {$sel:description:UpdatePolicy' :: Maybe Text
description = Maybe Text
a} :: UpdatePolicy)

-- | If provided, the new name for the policy.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of any of the characters in the
-- ASCII character range.
updatePolicy_name :: Lens.Lens' UpdatePolicy (Prelude.Maybe Prelude.Text)
updatePolicy_name :: Lens' UpdatePolicy (Maybe Text)
updatePolicy_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePolicy' {Maybe Text
name :: Maybe Text
$sel:name:UpdatePolicy' :: UpdatePolicy -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdatePolicy
s@UpdatePolicy' {} Maybe Text
a -> UpdatePolicy
s {$sel:name:UpdatePolicy' :: Maybe Text
name = Maybe Text
a} :: UpdatePolicy)

-- | The unique identifier (ID) of the policy that you want to update.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
-- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
-- letters, digits, or the underscore character (_).
updatePolicy_policyId :: Lens.Lens' UpdatePolicy Prelude.Text
updatePolicy_policyId :: Lens' UpdatePolicy Text
updatePolicy_policyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePolicy' {Text
policyId :: Text
$sel:policyId:UpdatePolicy' :: UpdatePolicy -> Text
policyId} -> Text
policyId) (\s :: UpdatePolicy
s@UpdatePolicy' {} Text
a -> UpdatePolicy
s {$sel:policyId:UpdatePolicy' :: Text
policyId = Text
a} :: UpdatePolicy)

instance Core.AWSRequest UpdatePolicy where
  type AWSResponse UpdatePolicy = UpdatePolicyResponse
  request :: (Service -> Service) -> UpdatePolicy -> Request UpdatePolicy
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 UpdatePolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePolicy)))
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 Policy -> Int -> UpdatePolicyResponse
UpdatePolicyResponse'
            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
"Policy")
            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 UpdatePolicy where
  hashWithSalt :: Int -> UpdatePolicy -> Int
hashWithSalt Int
_salt UpdatePolicy' {Maybe Text
Text
policyId :: Text
name :: Maybe Text
description :: Maybe Text
content :: Maybe Text
$sel:policyId:UpdatePolicy' :: UpdatePolicy -> Text
$sel:name:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:description:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:content:UpdatePolicy' :: UpdatePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyId

instance Prelude.NFData UpdatePolicy where
  rnf :: UpdatePolicy -> ()
rnf UpdatePolicy' {Maybe Text
Text
policyId :: Text
name :: Maybe Text
description :: Maybe Text
content :: Maybe Text
$sel:policyId:UpdatePolicy' :: UpdatePolicy -> Text
$sel:name:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:description:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:content:UpdatePolicy' :: UpdatePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
content
      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 Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyId

instance Data.ToHeaders UpdatePolicy where
  toHeaders :: UpdatePolicy -> 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
"AWSOrganizationsV20161128.UpdatePolicy" ::
                          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 UpdatePolicy where
  toJSON :: UpdatePolicy -> Value
toJSON UpdatePolicy' {Maybe Text
Text
policyId :: Text
name :: Maybe Text
description :: Maybe Text
content :: Maybe Text
$sel:policyId:UpdatePolicy' :: UpdatePolicy -> Text
$sel:name:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:description:UpdatePolicy' :: UpdatePolicy -> Maybe Text
$sel:content:UpdatePolicy' :: UpdatePolicy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Content" 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
content,
            (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,
            (Key
"Name" 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
name,
            forall a. a -> Maybe a
Prelude.Just (Key
"PolicyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
policyId)
          ]
      )

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

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

-- | /See:/ 'newUpdatePolicyResponse' smart constructor.
data UpdatePolicyResponse = UpdatePolicyResponse'
  { -- | A structure that contains details about the updated policy, showing the
    -- requested changes.
    UpdatePolicyResponse -> Maybe Policy
policy :: Prelude.Maybe Policy,
    -- | The response's http status code.
    UpdatePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePolicyResponse -> UpdatePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePolicyResponse -> UpdatePolicyResponse -> Bool
$c/= :: UpdatePolicyResponse -> UpdatePolicyResponse -> Bool
== :: UpdatePolicyResponse -> UpdatePolicyResponse -> Bool
$c== :: UpdatePolicyResponse -> UpdatePolicyResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePolicyResponse]
ReadPrec UpdatePolicyResponse
Int -> ReadS UpdatePolicyResponse
ReadS [UpdatePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePolicyResponse]
$creadListPrec :: ReadPrec [UpdatePolicyResponse]
readPrec :: ReadPrec UpdatePolicyResponse
$creadPrec :: ReadPrec UpdatePolicyResponse
readList :: ReadS [UpdatePolicyResponse]
$creadList :: ReadS [UpdatePolicyResponse]
readsPrec :: Int -> ReadS UpdatePolicyResponse
$creadsPrec :: Int -> ReadS UpdatePolicyResponse
Prelude.Read, Int -> UpdatePolicyResponse -> ShowS
[UpdatePolicyResponse] -> ShowS
UpdatePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePolicyResponse] -> ShowS
$cshowList :: [UpdatePolicyResponse] -> ShowS
show :: UpdatePolicyResponse -> String
$cshow :: UpdatePolicyResponse -> String
showsPrec :: Int -> UpdatePolicyResponse -> ShowS
$cshowsPrec :: Int -> UpdatePolicyResponse -> ShowS
Prelude.Show, forall x. Rep UpdatePolicyResponse x -> UpdatePolicyResponse
forall x. UpdatePolicyResponse -> Rep UpdatePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePolicyResponse x -> UpdatePolicyResponse
$cfrom :: forall x. UpdatePolicyResponse -> Rep UpdatePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePolicyResponse' 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:
--
-- 'policy', 'updatePolicyResponse_policy' - A structure that contains details about the updated policy, showing the
-- requested changes.
--
-- 'httpStatus', 'updatePolicyResponse_httpStatus' - The response's http status code.
newUpdatePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePolicyResponse
newUpdatePolicyResponse :: Int -> UpdatePolicyResponse
newUpdatePolicyResponse Int
pHttpStatus_ =
  UpdatePolicyResponse'
    { $sel:policy:UpdatePolicyResponse' :: Maybe Policy
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains details about the updated policy, showing the
-- requested changes.
updatePolicyResponse_policy :: Lens.Lens' UpdatePolicyResponse (Prelude.Maybe Policy)
updatePolicyResponse_policy :: Lens' UpdatePolicyResponse (Maybe Policy)
updatePolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePolicyResponse' {Maybe Policy
policy :: Maybe Policy
$sel:policy:UpdatePolicyResponse' :: UpdatePolicyResponse -> Maybe Policy
policy} -> Maybe Policy
policy) (\s :: UpdatePolicyResponse
s@UpdatePolicyResponse' {} Maybe Policy
a -> UpdatePolicyResponse
s {$sel:policy:UpdatePolicyResponse' :: Maybe Policy
policy = Maybe Policy
a} :: UpdatePolicyResponse)

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

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