{-# 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.GetChannelPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the channel\'s IAM policy. IAM policies are used to control
-- access to your channel.
module Amazonka.MediaTailor.GetChannelPolicy
  ( -- * Creating a Request
    GetChannelPolicy (..),
    newGetChannelPolicy,

    -- * Request Lenses
    getChannelPolicy_channelName,

    -- * Destructuring the Response
    GetChannelPolicyResponse (..),
    newGetChannelPolicyResponse,

    -- * Response Lenses
    getChannelPolicyResponse_policy,
    getChannelPolicyResponse_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:/ 'newGetChannelPolicy' smart constructor.
data GetChannelPolicy = GetChannelPolicy'
  { -- | The name of the channel associated with this Channel Policy.
    GetChannelPolicy -> Text
channelName :: Prelude.Text
  }
  deriving (GetChannelPolicy -> GetChannelPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannelPolicy -> GetChannelPolicy -> Bool
$c/= :: GetChannelPolicy -> GetChannelPolicy -> Bool
== :: GetChannelPolicy -> GetChannelPolicy -> Bool
$c== :: GetChannelPolicy -> GetChannelPolicy -> Bool
Prelude.Eq, ReadPrec [GetChannelPolicy]
ReadPrec GetChannelPolicy
Int -> ReadS GetChannelPolicy
ReadS [GetChannelPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannelPolicy]
$creadListPrec :: ReadPrec [GetChannelPolicy]
readPrec :: ReadPrec GetChannelPolicy
$creadPrec :: ReadPrec GetChannelPolicy
readList :: ReadS [GetChannelPolicy]
$creadList :: ReadS [GetChannelPolicy]
readsPrec :: Int -> ReadS GetChannelPolicy
$creadsPrec :: Int -> ReadS GetChannelPolicy
Prelude.Read, Int -> GetChannelPolicy -> ShowS
[GetChannelPolicy] -> ShowS
GetChannelPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannelPolicy] -> ShowS
$cshowList :: [GetChannelPolicy] -> ShowS
show :: GetChannelPolicy -> String
$cshow :: GetChannelPolicy -> String
showsPrec :: Int -> GetChannelPolicy -> ShowS
$cshowsPrec :: Int -> GetChannelPolicy -> ShowS
Prelude.Show, forall x. Rep GetChannelPolicy x -> GetChannelPolicy
forall x. GetChannelPolicy -> Rep GetChannelPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetChannelPolicy x -> GetChannelPolicy
$cfrom :: forall x. GetChannelPolicy -> Rep GetChannelPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetChannelPolicy' 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', 'getChannelPolicy_channelName' - The name of the channel associated with this Channel Policy.
newGetChannelPolicy ::
  -- | 'channelName'
  Prelude.Text ->
  GetChannelPolicy
newGetChannelPolicy :: Text -> GetChannelPolicy
newGetChannelPolicy Text
pChannelName_ =
  GetChannelPolicy' {$sel:channelName:GetChannelPolicy' :: Text
channelName = Text
pChannelName_}

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

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

instance Prelude.NFData GetChannelPolicy where
  rnf :: GetChannelPolicy -> ()
rnf GetChannelPolicy' {Text
channelName :: Text
$sel:channelName:GetChannelPolicy' :: GetChannelPolicy -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
channelName

instance Data.ToHeaders GetChannelPolicy where
  toHeaders :: GetChannelPolicy -> 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.ToPath GetChannelPolicy where
  toPath :: GetChannelPolicy -> ByteString
toPath GetChannelPolicy' {Text
channelName :: Text
$sel:channelName:GetChannelPolicy' :: GetChannelPolicy -> 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 GetChannelPolicy where
  toQuery :: GetChannelPolicy -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetChannelPolicyResponse' smart constructor.
data GetChannelPolicyResponse = GetChannelPolicyResponse'
  { -- | The IAM policy for the channel. IAM policies are used to control access
    -- to your channel.
    GetChannelPolicyResponse -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetChannelPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetChannelPolicyResponse -> GetChannelPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannelPolicyResponse -> GetChannelPolicyResponse -> Bool
$c/= :: GetChannelPolicyResponse -> GetChannelPolicyResponse -> Bool
== :: GetChannelPolicyResponse -> GetChannelPolicyResponse -> Bool
$c== :: GetChannelPolicyResponse -> GetChannelPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetChannelPolicyResponse]
ReadPrec GetChannelPolicyResponse
Int -> ReadS GetChannelPolicyResponse
ReadS [GetChannelPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannelPolicyResponse]
$creadListPrec :: ReadPrec [GetChannelPolicyResponse]
readPrec :: ReadPrec GetChannelPolicyResponse
$creadPrec :: ReadPrec GetChannelPolicyResponse
readList :: ReadS [GetChannelPolicyResponse]
$creadList :: ReadS [GetChannelPolicyResponse]
readsPrec :: Int -> ReadS GetChannelPolicyResponse
$creadsPrec :: Int -> ReadS GetChannelPolicyResponse
Prelude.Read, Int -> GetChannelPolicyResponse -> ShowS
[GetChannelPolicyResponse] -> ShowS
GetChannelPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannelPolicyResponse] -> ShowS
$cshowList :: [GetChannelPolicyResponse] -> ShowS
show :: GetChannelPolicyResponse -> String
$cshow :: GetChannelPolicyResponse -> String
showsPrec :: Int -> GetChannelPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetChannelPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep GetChannelPolicyResponse x -> GetChannelPolicyResponse
forall x.
GetChannelPolicyResponse -> Rep GetChannelPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetChannelPolicyResponse x -> GetChannelPolicyResponse
$cfrom :: forall x.
GetChannelPolicyResponse -> Rep GetChannelPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetChannelPolicyResponse' 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', 'getChannelPolicyResponse_policy' - The IAM policy for the channel. IAM policies are used to control access
-- to your channel.
--
-- 'httpStatus', 'getChannelPolicyResponse_httpStatus' - The response's http status code.
newGetChannelPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetChannelPolicyResponse
newGetChannelPolicyResponse :: Int -> GetChannelPolicyResponse
newGetChannelPolicyResponse Int
pHttpStatus_ =
  GetChannelPolicyResponse'
    { $sel:policy:GetChannelPolicyResponse' :: Maybe Text
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetChannelPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IAM policy for the channel. IAM policies are used to control access
-- to your channel.
getChannelPolicyResponse_policy :: Lens.Lens' GetChannelPolicyResponse (Prelude.Maybe Prelude.Text)
getChannelPolicyResponse_policy :: Lens' GetChannelPolicyResponse (Maybe Text)
getChannelPolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelPolicyResponse' {Maybe Text
policy :: Maybe Text
$sel:policy:GetChannelPolicyResponse' :: GetChannelPolicyResponse -> Maybe Text
policy} -> Maybe Text
policy) (\s :: GetChannelPolicyResponse
s@GetChannelPolicyResponse' {} Maybe Text
a -> GetChannelPolicyResponse
s {$sel:policy:GetChannelPolicyResponse' :: Maybe Text
policy = Maybe Text
a} :: GetChannelPolicyResponse)

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

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