{-# 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.MediaStore.PutContainerPolicy
-- 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 an access policy for the specified container to restrict the
-- users and clients that can access it. For information about the data
-- that is included in an access policy, see the
-- <https://aws.amazon.com/documentation/iam/ AWS Identity and Access Management User Guide>.
--
-- For this release of the REST API, you can create only one policy for a
-- container. If you enter @PutContainerPolicy@ twice, the second command
-- modifies the existing policy.
module Amazonka.MediaStore.PutContainerPolicy
  ( -- * Creating a Request
    PutContainerPolicy (..),
    newPutContainerPolicy,

    -- * Request Lenses
    putContainerPolicy_containerName,
    putContainerPolicy_policy,

    -- * Destructuring the Response
    PutContainerPolicyResponse (..),
    newPutContainerPolicyResponse,

    -- * Response Lenses
    putContainerPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutContainerPolicy' smart constructor.
data PutContainerPolicy = PutContainerPolicy'
  { -- | The name of the container.
    PutContainerPolicy -> Text
containerName :: Prelude.Text,
    -- | The contents of the policy, which includes the following:
    --
    -- -   One @Version@ tag
    --
    -- -   One @Statement@ tag that contains the standard tags for the policy.
    PutContainerPolicy -> Text
policy :: Prelude.Text
  }
  deriving (PutContainerPolicy -> PutContainerPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutContainerPolicy -> PutContainerPolicy -> Bool
$c/= :: PutContainerPolicy -> PutContainerPolicy -> Bool
== :: PutContainerPolicy -> PutContainerPolicy -> Bool
$c== :: PutContainerPolicy -> PutContainerPolicy -> Bool
Prelude.Eq, ReadPrec [PutContainerPolicy]
ReadPrec PutContainerPolicy
Int -> ReadS PutContainerPolicy
ReadS [PutContainerPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutContainerPolicy]
$creadListPrec :: ReadPrec [PutContainerPolicy]
readPrec :: ReadPrec PutContainerPolicy
$creadPrec :: ReadPrec PutContainerPolicy
readList :: ReadS [PutContainerPolicy]
$creadList :: ReadS [PutContainerPolicy]
readsPrec :: Int -> ReadS PutContainerPolicy
$creadsPrec :: Int -> ReadS PutContainerPolicy
Prelude.Read, Int -> PutContainerPolicy -> ShowS
[PutContainerPolicy] -> ShowS
PutContainerPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutContainerPolicy] -> ShowS
$cshowList :: [PutContainerPolicy] -> ShowS
show :: PutContainerPolicy -> String
$cshow :: PutContainerPolicy -> String
showsPrec :: Int -> PutContainerPolicy -> ShowS
$cshowsPrec :: Int -> PutContainerPolicy -> ShowS
Prelude.Show, forall x. Rep PutContainerPolicy x -> PutContainerPolicy
forall x. PutContainerPolicy -> Rep PutContainerPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutContainerPolicy x -> PutContainerPolicy
$cfrom :: forall x. PutContainerPolicy -> Rep PutContainerPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutContainerPolicy' 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:
--
-- 'containerName', 'putContainerPolicy_containerName' - The name of the container.
--
-- 'policy', 'putContainerPolicy_policy' - The contents of the policy, which includes the following:
--
-- -   One @Version@ tag
--
-- -   One @Statement@ tag that contains the standard tags for the policy.
newPutContainerPolicy ::
  -- | 'containerName'
  Prelude.Text ->
  -- | 'policy'
  Prelude.Text ->
  PutContainerPolicy
newPutContainerPolicy :: Text -> Text -> PutContainerPolicy
newPutContainerPolicy Text
pContainerName_ Text
pPolicy_ =
  PutContainerPolicy'
    { $sel:containerName:PutContainerPolicy' :: Text
containerName =
        Text
pContainerName_,
      $sel:policy:PutContainerPolicy' :: Text
policy = Text
pPolicy_
    }

-- | The name of the container.
putContainerPolicy_containerName :: Lens.Lens' PutContainerPolicy Prelude.Text
putContainerPolicy_containerName :: Lens' PutContainerPolicy Text
putContainerPolicy_containerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutContainerPolicy' {Text
containerName :: Text
$sel:containerName:PutContainerPolicy' :: PutContainerPolicy -> Text
containerName} -> Text
containerName) (\s :: PutContainerPolicy
s@PutContainerPolicy' {} Text
a -> PutContainerPolicy
s {$sel:containerName:PutContainerPolicy' :: Text
containerName = Text
a} :: PutContainerPolicy)

-- | The contents of the policy, which includes the following:
--
-- -   One @Version@ tag
--
-- -   One @Statement@ tag that contains the standard tags for the policy.
putContainerPolicy_policy :: Lens.Lens' PutContainerPolicy Prelude.Text
putContainerPolicy_policy :: Lens' PutContainerPolicy Text
putContainerPolicy_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutContainerPolicy' {Text
policy :: Text
$sel:policy:PutContainerPolicy' :: PutContainerPolicy -> Text
policy} -> Text
policy) (\s :: PutContainerPolicy
s@PutContainerPolicy' {} Text
a -> PutContainerPolicy
s {$sel:policy:PutContainerPolicy' :: Text
policy = Text
a} :: PutContainerPolicy)

instance Core.AWSRequest PutContainerPolicy where
  type
    AWSResponse PutContainerPolicy =
      PutContainerPolicyResponse
  request :: (Service -> Service)
-> PutContainerPolicy -> Request PutContainerPolicy
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 PutContainerPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutContainerPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutContainerPolicyResponse
PutContainerPolicyResponse'
            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))
      )

instance Prelude.Hashable PutContainerPolicy where
  hashWithSalt :: Int -> PutContainerPolicy -> Int
hashWithSalt Int
_salt PutContainerPolicy' {Text
policy :: Text
containerName :: Text
$sel:policy:PutContainerPolicy' :: PutContainerPolicy -> Text
$sel:containerName:PutContainerPolicy' :: PutContainerPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
containerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policy

instance Prelude.NFData PutContainerPolicy where
  rnf :: PutContainerPolicy -> ()
rnf PutContainerPolicy' {Text
policy :: Text
containerName :: Text
$sel:policy:PutContainerPolicy' :: PutContainerPolicy -> Text
$sel:containerName:PutContainerPolicy' :: PutContainerPolicy -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
containerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policy

instance Data.ToHeaders PutContainerPolicy where
  toHeaders :: PutContainerPolicy -> 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
"MediaStore_20170901.PutContainerPolicy" ::
                          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 PutContainerPolicy where
  toJSON :: PutContainerPolicy -> Value
toJSON PutContainerPolicy' {Text
policy :: Text
containerName :: Text
$sel:policy:PutContainerPolicy' :: PutContainerPolicy -> Text
$sel:containerName:PutContainerPolicy' :: PutContainerPolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ContainerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
containerName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Policy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
policy)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutContainerPolicyResponse' 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', 'putContainerPolicyResponse_httpStatus' - The response's http status code.
newPutContainerPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutContainerPolicyResponse
newPutContainerPolicyResponse :: Int -> PutContainerPolicyResponse
newPutContainerPolicyResponse Int
pHttpStatus_ =
  PutContainerPolicyResponse'
    { $sel:httpStatus:PutContainerPolicyResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData PutContainerPolicyResponse where
  rnf :: PutContainerPolicyResponse -> ()
rnf PutContainerPolicyResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutContainerPolicyResponse' :: PutContainerPolicyResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus