{-# 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.MediaTailor.PutChannelPolicy
-- 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 IAM policy for the channel. IAM policies are used to control
-- access to your channel.
module Amazonka.MediaTailor.PutChannelPolicy
  ( -- * Creating a Request
    PutChannelPolicy (..),
    newPutChannelPolicy,

    -- * Request Lenses
    putChannelPolicy_channelName,
    putChannelPolicy_policy,

    -- * Destructuring the Response
    PutChannelPolicyResponse (..),
    newPutChannelPolicyResponse,

    -- * Response Lenses
    putChannelPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutChannelPolicy' smart constructor.
data PutChannelPolicy = PutChannelPolicy'
  { -- | The channel name associated with this Channel Policy.
    PutChannelPolicy -> Text
channelName :: Prelude.Text,
    -- | Adds an IAM role that determines the permissions of your channel.
    PutChannelPolicy -> Text
policy :: Prelude.Text
  }
  deriving (PutChannelPolicy -> PutChannelPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutChannelPolicy -> PutChannelPolicy -> Bool
$c/= :: PutChannelPolicy -> PutChannelPolicy -> Bool
== :: PutChannelPolicy -> PutChannelPolicy -> Bool
$c== :: PutChannelPolicy -> PutChannelPolicy -> Bool
Prelude.Eq, ReadPrec [PutChannelPolicy]
ReadPrec PutChannelPolicy
Int -> ReadS PutChannelPolicy
ReadS [PutChannelPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutChannelPolicy]
$creadListPrec :: ReadPrec [PutChannelPolicy]
readPrec :: ReadPrec PutChannelPolicy
$creadPrec :: ReadPrec PutChannelPolicy
readList :: ReadS [PutChannelPolicy]
$creadList :: ReadS [PutChannelPolicy]
readsPrec :: Int -> ReadS PutChannelPolicy
$creadsPrec :: Int -> ReadS PutChannelPolicy
Prelude.Read, Int -> PutChannelPolicy -> ShowS
[PutChannelPolicy] -> ShowS
PutChannelPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutChannelPolicy] -> ShowS
$cshowList :: [PutChannelPolicy] -> ShowS
show :: PutChannelPolicy -> String
$cshow :: PutChannelPolicy -> String
showsPrec :: Int -> PutChannelPolicy -> ShowS
$cshowsPrec :: Int -> PutChannelPolicy -> ShowS
Prelude.Show, forall x. Rep PutChannelPolicy x -> PutChannelPolicy
forall x. PutChannelPolicy -> Rep PutChannelPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutChannelPolicy x -> PutChannelPolicy
$cfrom :: forall x. PutChannelPolicy -> Rep PutChannelPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutChannelPolicy' 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:
--
-- 'channelName', 'putChannelPolicy_channelName' - The channel name associated with this Channel Policy.
--
-- 'policy', 'putChannelPolicy_policy' - Adds an IAM role that determines the permissions of your channel.
newPutChannelPolicy ::
  -- | 'channelName'
  Prelude.Text ->
  -- | 'policy'
  Prelude.Text ->
  PutChannelPolicy
newPutChannelPolicy :: Text -> Text -> PutChannelPolicy
newPutChannelPolicy Text
pChannelName_ Text
pPolicy_ =
  PutChannelPolicy'
    { $sel:channelName:PutChannelPolicy' :: Text
channelName = Text
pChannelName_,
      $sel:policy:PutChannelPolicy' :: Text
policy = Text
pPolicy_
    }

-- | The channel name associated with this Channel Policy.
putChannelPolicy_channelName :: Lens.Lens' PutChannelPolicy Prelude.Text
putChannelPolicy_channelName :: Lens' PutChannelPolicy Text
putChannelPolicy_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChannelPolicy' {Text
channelName :: Text
$sel:channelName:PutChannelPolicy' :: PutChannelPolicy -> Text
channelName} -> Text
channelName) (\s :: PutChannelPolicy
s@PutChannelPolicy' {} Text
a -> PutChannelPolicy
s {$sel:channelName:PutChannelPolicy' :: Text
channelName = Text
a} :: PutChannelPolicy)

-- | Adds an IAM role that determines the permissions of your channel.
putChannelPolicy_policy :: Lens.Lens' PutChannelPolicy Prelude.Text
putChannelPolicy_policy :: Lens' PutChannelPolicy Text
putChannelPolicy_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChannelPolicy' {Text
policy :: Text
$sel:policy:PutChannelPolicy' :: PutChannelPolicy -> Text
policy} -> Text
policy) (\s :: PutChannelPolicy
s@PutChannelPolicy' {} Text
a -> PutChannelPolicy
s {$sel:policy:PutChannelPolicy' :: Text
policy = Text
a} :: PutChannelPolicy)

instance Core.AWSRequest PutChannelPolicy where
  type
    AWSResponse PutChannelPolicy =
      PutChannelPolicyResponse
  request :: (Service -> Service)
-> PutChannelPolicy -> Request PutChannelPolicy
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutChannelPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutChannelPolicy)))
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 -> PutChannelPolicyResponse
PutChannelPolicyResponse'
            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 PutChannelPolicy where
  hashWithSalt :: Int -> PutChannelPolicy -> Int
hashWithSalt Int
_salt PutChannelPolicy' {Text
policy :: Text
channelName :: Text
$sel:policy:PutChannelPolicy' :: PutChannelPolicy -> Text
$sel:channelName:PutChannelPolicy' :: PutChannelPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policy

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

instance Data.ToHeaders PutChannelPolicy where
  toHeaders :: PutChannelPolicy -> 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 PutChannelPolicy where
  toJSON :: PutChannelPolicy -> Value
toJSON PutChannelPolicy' {Text
policy :: Text
channelName :: Text
$sel:policy:PutChannelPolicy' :: PutChannelPolicy -> Text
$sel:channelName:PutChannelPolicy' :: PutChannelPolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 PutChannelPolicy where
  toPath :: PutChannelPolicy -> ByteString
toPath PutChannelPolicy' {Text
policy :: Text
channelName :: Text
$sel:policy:PutChannelPolicy' :: PutChannelPolicy -> Text
$sel:channelName:PutChannelPolicy' :: PutChannelPolicy -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/channel/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelName, ByteString
"/policy"]

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

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

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

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

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