{-# 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.MediaConnect.UpdateFlowEntitlement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You can change an entitlement\'s description, subscribers, and
-- encryption. If you change the subscribers, the service will remove the
-- outputs that are are used by the subscribers that are removed.
module Amazonka.MediaConnect.UpdateFlowEntitlement
  ( -- * Creating a Request
    UpdateFlowEntitlement (..),
    newUpdateFlowEntitlement,

    -- * Request Lenses
    updateFlowEntitlement_description,
    updateFlowEntitlement_encryption,
    updateFlowEntitlement_entitlementStatus,
    updateFlowEntitlement_subscribers,
    updateFlowEntitlement_flowArn,
    updateFlowEntitlement_entitlementArn,

    -- * Destructuring the Response
    UpdateFlowEntitlementResponse (..),
    newUpdateFlowEntitlementResponse,

    -- * Response Lenses
    updateFlowEntitlementResponse_entitlement,
    updateFlowEntitlementResponse_flowArn,
    updateFlowEntitlementResponse_httpStatus,
  )
where

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

-- | The entitlement fields that you want to update.
--
-- /See:/ 'newUpdateFlowEntitlement' smart constructor.
data UpdateFlowEntitlement = UpdateFlowEntitlement'
  { -- | A description of the entitlement. This description appears only on the
    -- AWS Elemental MediaConnect console and will not be seen by the
    -- subscriber or end user.
    UpdateFlowEntitlement -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The type of encryption that will be used on the output associated with
    -- this entitlement.
    UpdateFlowEntitlement -> Maybe UpdateEncryption
encryption :: Prelude.Maybe UpdateEncryption,
    -- | An indication of whether you want to enable the entitlement to allow
    -- access, or disable it to stop streaming content to the subscriber’s flow
    -- temporarily. If you don’t specify the entitlementStatus field in your
    -- request, MediaConnect leaves the value unchanged.
    UpdateFlowEntitlement -> Maybe EntitlementStatus
entitlementStatus :: Prelude.Maybe EntitlementStatus,
    -- | The AWS account IDs that you want to share your content with. The
    -- receiving accounts (subscribers) will be allowed to create their own
    -- flow using your content as the source.
    UpdateFlowEntitlement -> Maybe [Text]
subscribers :: Prelude.Maybe [Prelude.Text],
    -- | The flow that is associated with the entitlement that you want to
    -- update.
    UpdateFlowEntitlement -> Text
flowArn :: Prelude.Text,
    -- | The ARN of the entitlement that you want to update.
    UpdateFlowEntitlement -> Text
entitlementArn :: Prelude.Text
  }
  deriving (UpdateFlowEntitlement -> UpdateFlowEntitlement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlowEntitlement -> UpdateFlowEntitlement -> Bool
$c/= :: UpdateFlowEntitlement -> UpdateFlowEntitlement -> Bool
== :: UpdateFlowEntitlement -> UpdateFlowEntitlement -> Bool
$c== :: UpdateFlowEntitlement -> UpdateFlowEntitlement -> Bool
Prelude.Eq, ReadPrec [UpdateFlowEntitlement]
ReadPrec UpdateFlowEntitlement
Int -> ReadS UpdateFlowEntitlement
ReadS [UpdateFlowEntitlement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlowEntitlement]
$creadListPrec :: ReadPrec [UpdateFlowEntitlement]
readPrec :: ReadPrec UpdateFlowEntitlement
$creadPrec :: ReadPrec UpdateFlowEntitlement
readList :: ReadS [UpdateFlowEntitlement]
$creadList :: ReadS [UpdateFlowEntitlement]
readsPrec :: Int -> ReadS UpdateFlowEntitlement
$creadsPrec :: Int -> ReadS UpdateFlowEntitlement
Prelude.Read, Int -> UpdateFlowEntitlement -> ShowS
[UpdateFlowEntitlement] -> ShowS
UpdateFlowEntitlement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlowEntitlement] -> ShowS
$cshowList :: [UpdateFlowEntitlement] -> ShowS
show :: UpdateFlowEntitlement -> String
$cshow :: UpdateFlowEntitlement -> String
showsPrec :: Int -> UpdateFlowEntitlement -> ShowS
$cshowsPrec :: Int -> UpdateFlowEntitlement -> ShowS
Prelude.Show, forall x. Rep UpdateFlowEntitlement x -> UpdateFlowEntitlement
forall x. UpdateFlowEntitlement -> Rep UpdateFlowEntitlement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFlowEntitlement x -> UpdateFlowEntitlement
$cfrom :: forall x. UpdateFlowEntitlement -> Rep UpdateFlowEntitlement x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlowEntitlement' 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:
--
-- 'description', 'updateFlowEntitlement_description' - A description of the entitlement. This description appears only on the
-- AWS Elemental MediaConnect console and will not be seen by the
-- subscriber or end user.
--
-- 'encryption', 'updateFlowEntitlement_encryption' - The type of encryption that will be used on the output associated with
-- this entitlement.
--
-- 'entitlementStatus', 'updateFlowEntitlement_entitlementStatus' - An indication of whether you want to enable the entitlement to allow
-- access, or disable it to stop streaming content to the subscriber’s flow
-- temporarily. If you don’t specify the entitlementStatus field in your
-- request, MediaConnect leaves the value unchanged.
--
-- 'subscribers', 'updateFlowEntitlement_subscribers' - The AWS account IDs that you want to share your content with. The
-- receiving accounts (subscribers) will be allowed to create their own
-- flow using your content as the source.
--
-- 'flowArn', 'updateFlowEntitlement_flowArn' - The flow that is associated with the entitlement that you want to
-- update.
--
-- 'entitlementArn', 'updateFlowEntitlement_entitlementArn' - The ARN of the entitlement that you want to update.
newUpdateFlowEntitlement ::
  -- | 'flowArn'
  Prelude.Text ->
  -- | 'entitlementArn'
  Prelude.Text ->
  UpdateFlowEntitlement
newUpdateFlowEntitlement :: Text -> Text -> UpdateFlowEntitlement
newUpdateFlowEntitlement Text
pFlowArn_ Text
pEntitlementArn_ =
  UpdateFlowEntitlement'
    { $sel:description:UpdateFlowEntitlement' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:encryption:UpdateFlowEntitlement' :: Maybe UpdateEncryption
encryption = forall a. Maybe a
Prelude.Nothing,
      $sel:entitlementStatus:UpdateFlowEntitlement' :: Maybe EntitlementStatus
entitlementStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:subscribers:UpdateFlowEntitlement' :: Maybe [Text]
subscribers = forall a. Maybe a
Prelude.Nothing,
      $sel:flowArn:UpdateFlowEntitlement' :: Text
flowArn = Text
pFlowArn_,
      $sel:entitlementArn:UpdateFlowEntitlement' :: Text
entitlementArn = Text
pEntitlementArn_
    }

-- | A description of the entitlement. This description appears only on the
-- AWS Elemental MediaConnect console and will not be seen by the
-- subscriber or end user.
updateFlowEntitlement_description :: Lens.Lens' UpdateFlowEntitlement (Prelude.Maybe Prelude.Text)
updateFlowEntitlement_description :: Lens' UpdateFlowEntitlement (Maybe Text)
updateFlowEntitlement_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Maybe Text
a -> UpdateFlowEntitlement
s {$sel:description:UpdateFlowEntitlement' :: Maybe Text
description = Maybe Text
a} :: UpdateFlowEntitlement)

-- | The type of encryption that will be used on the output associated with
-- this entitlement.
updateFlowEntitlement_encryption :: Lens.Lens' UpdateFlowEntitlement (Prelude.Maybe UpdateEncryption)
updateFlowEntitlement_encryption :: Lens' UpdateFlowEntitlement (Maybe UpdateEncryption)
updateFlowEntitlement_encryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Maybe UpdateEncryption
encryption :: Maybe UpdateEncryption
$sel:encryption:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe UpdateEncryption
encryption} -> Maybe UpdateEncryption
encryption) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Maybe UpdateEncryption
a -> UpdateFlowEntitlement
s {$sel:encryption:UpdateFlowEntitlement' :: Maybe UpdateEncryption
encryption = Maybe UpdateEncryption
a} :: UpdateFlowEntitlement)

-- | An indication of whether you want to enable the entitlement to allow
-- access, or disable it to stop streaming content to the subscriber’s flow
-- temporarily. If you don’t specify the entitlementStatus field in your
-- request, MediaConnect leaves the value unchanged.
updateFlowEntitlement_entitlementStatus :: Lens.Lens' UpdateFlowEntitlement (Prelude.Maybe EntitlementStatus)
updateFlowEntitlement_entitlementStatus :: Lens' UpdateFlowEntitlement (Maybe EntitlementStatus)
updateFlowEntitlement_entitlementStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Maybe EntitlementStatus
entitlementStatus :: Maybe EntitlementStatus
$sel:entitlementStatus:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe EntitlementStatus
entitlementStatus} -> Maybe EntitlementStatus
entitlementStatus) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Maybe EntitlementStatus
a -> UpdateFlowEntitlement
s {$sel:entitlementStatus:UpdateFlowEntitlement' :: Maybe EntitlementStatus
entitlementStatus = Maybe EntitlementStatus
a} :: UpdateFlowEntitlement)

-- | The AWS account IDs that you want to share your content with. The
-- receiving accounts (subscribers) will be allowed to create their own
-- flow using your content as the source.
updateFlowEntitlement_subscribers :: Lens.Lens' UpdateFlowEntitlement (Prelude.Maybe [Prelude.Text])
updateFlowEntitlement_subscribers :: Lens' UpdateFlowEntitlement (Maybe [Text])
updateFlowEntitlement_subscribers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Maybe [Text]
subscribers :: Maybe [Text]
$sel:subscribers:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe [Text]
subscribers} -> Maybe [Text]
subscribers) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Maybe [Text]
a -> UpdateFlowEntitlement
s {$sel:subscribers:UpdateFlowEntitlement' :: Maybe [Text]
subscribers = Maybe [Text]
a} :: UpdateFlowEntitlement) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The flow that is associated with the entitlement that you want to
-- update.
updateFlowEntitlement_flowArn :: Lens.Lens' UpdateFlowEntitlement Prelude.Text
updateFlowEntitlement_flowArn :: Lens' UpdateFlowEntitlement Text
updateFlowEntitlement_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Text
flowArn :: Text
$sel:flowArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
flowArn} -> Text
flowArn) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Text
a -> UpdateFlowEntitlement
s {$sel:flowArn:UpdateFlowEntitlement' :: Text
flowArn = Text
a} :: UpdateFlowEntitlement)

-- | The ARN of the entitlement that you want to update.
updateFlowEntitlement_entitlementArn :: Lens.Lens' UpdateFlowEntitlement Prelude.Text
updateFlowEntitlement_entitlementArn :: Lens' UpdateFlowEntitlement Text
updateFlowEntitlement_entitlementArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlement' {Text
entitlementArn :: Text
$sel:entitlementArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
entitlementArn} -> Text
entitlementArn) (\s :: UpdateFlowEntitlement
s@UpdateFlowEntitlement' {} Text
a -> UpdateFlowEntitlement
s {$sel:entitlementArn:UpdateFlowEntitlement' :: Text
entitlementArn = Text
a} :: UpdateFlowEntitlement)

instance Core.AWSRequest UpdateFlowEntitlement where
  type
    AWSResponse UpdateFlowEntitlement =
      UpdateFlowEntitlementResponse
  request :: (Service -> Service)
-> UpdateFlowEntitlement -> Request UpdateFlowEntitlement
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 UpdateFlowEntitlement
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateFlowEntitlement)))
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 Entitlement
-> Maybe Text -> Int -> UpdateFlowEntitlementResponse
UpdateFlowEntitlementResponse'
            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
"entitlement")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"flowArn")
            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 UpdateFlowEntitlement where
  hashWithSalt :: Int -> UpdateFlowEntitlement -> Int
hashWithSalt Int
_salt UpdateFlowEntitlement' {Maybe [Text]
Maybe Text
Maybe EntitlementStatus
Maybe UpdateEncryption
Text
entitlementArn :: Text
flowArn :: Text
subscribers :: Maybe [Text]
entitlementStatus :: Maybe EntitlementStatus
encryption :: Maybe UpdateEncryption
description :: Maybe Text
$sel:entitlementArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:flowArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:subscribers:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe [Text]
$sel:entitlementStatus:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe EntitlementStatus
$sel:encryption:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe UpdateEncryption
$sel:description:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateEncryption
encryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EntitlementStatus
entitlementStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subscribers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
entitlementArn

instance Prelude.NFData UpdateFlowEntitlement where
  rnf :: UpdateFlowEntitlement -> ()
rnf UpdateFlowEntitlement' {Maybe [Text]
Maybe Text
Maybe EntitlementStatus
Maybe UpdateEncryption
Text
entitlementArn :: Text
flowArn :: Text
subscribers :: Maybe [Text]
entitlementStatus :: Maybe EntitlementStatus
encryption :: Maybe UpdateEncryption
description :: Maybe Text
$sel:entitlementArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:flowArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:subscribers:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe [Text]
$sel:entitlementStatus:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe EntitlementStatus
$sel:encryption:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe UpdateEncryption
$sel:description:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe Text
..} =
    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 UpdateEncryption
encryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntitlementStatus
entitlementStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subscribers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
entitlementArn

instance Data.ToHeaders UpdateFlowEntitlement where
  toHeaders :: UpdateFlowEntitlement -> 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 UpdateFlowEntitlement where
  toJSON :: UpdateFlowEntitlement -> Value
toJSON UpdateFlowEntitlement' {Maybe [Text]
Maybe Text
Maybe EntitlementStatus
Maybe UpdateEncryption
Text
entitlementArn :: Text
flowArn :: Text
subscribers :: Maybe [Text]
entitlementStatus :: Maybe EntitlementStatus
encryption :: Maybe UpdateEncryption
description :: Maybe Text
$sel:entitlementArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:flowArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:subscribers:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe [Text]
$sel:entitlementStatus:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe EntitlementStatus
$sel:encryption:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe UpdateEncryption
$sel:description:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"encryption" 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 UpdateEncryption
encryption,
            (Key
"entitlementStatus" 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 EntitlementStatus
entitlementStatus,
            (Key
"subscribers" 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]
subscribers
          ]
      )

instance Data.ToPath UpdateFlowEntitlement where
  toPath :: UpdateFlowEntitlement -> ByteString
toPath UpdateFlowEntitlement' {Maybe [Text]
Maybe Text
Maybe EntitlementStatus
Maybe UpdateEncryption
Text
entitlementArn :: Text
flowArn :: Text
subscribers :: Maybe [Text]
entitlementStatus :: Maybe EntitlementStatus
encryption :: Maybe UpdateEncryption
description :: Maybe Text
$sel:entitlementArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:flowArn:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Text
$sel:subscribers:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe [Text]
$sel:entitlementStatus:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe EntitlementStatus
$sel:encryption:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe UpdateEncryption
$sel:description:UpdateFlowEntitlement' :: UpdateFlowEntitlement -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/flows/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
flowArn,
        ByteString
"/entitlements/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
entitlementArn
      ]

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

-- | /See:/ 'newUpdateFlowEntitlementResponse' smart constructor.
data UpdateFlowEntitlementResponse = UpdateFlowEntitlementResponse'
  { -- | The new configuration of the entitlement that you updated.
    UpdateFlowEntitlementResponse -> Maybe Entitlement
entitlement :: Prelude.Maybe Entitlement,
    -- | The ARN of the flow that this entitlement was granted on.
    UpdateFlowEntitlementResponse -> Maybe Text
flowArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateFlowEntitlementResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFlowEntitlementResponse
-> UpdateFlowEntitlementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlowEntitlementResponse
-> UpdateFlowEntitlementResponse -> Bool
$c/= :: UpdateFlowEntitlementResponse
-> UpdateFlowEntitlementResponse -> Bool
== :: UpdateFlowEntitlementResponse
-> UpdateFlowEntitlementResponse -> Bool
$c== :: UpdateFlowEntitlementResponse
-> UpdateFlowEntitlementResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFlowEntitlementResponse]
ReadPrec UpdateFlowEntitlementResponse
Int -> ReadS UpdateFlowEntitlementResponse
ReadS [UpdateFlowEntitlementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlowEntitlementResponse]
$creadListPrec :: ReadPrec [UpdateFlowEntitlementResponse]
readPrec :: ReadPrec UpdateFlowEntitlementResponse
$creadPrec :: ReadPrec UpdateFlowEntitlementResponse
readList :: ReadS [UpdateFlowEntitlementResponse]
$creadList :: ReadS [UpdateFlowEntitlementResponse]
readsPrec :: Int -> ReadS UpdateFlowEntitlementResponse
$creadsPrec :: Int -> ReadS UpdateFlowEntitlementResponse
Prelude.Read, Int -> UpdateFlowEntitlementResponse -> ShowS
[UpdateFlowEntitlementResponse] -> ShowS
UpdateFlowEntitlementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlowEntitlementResponse] -> ShowS
$cshowList :: [UpdateFlowEntitlementResponse] -> ShowS
show :: UpdateFlowEntitlementResponse -> String
$cshow :: UpdateFlowEntitlementResponse -> String
showsPrec :: Int -> UpdateFlowEntitlementResponse -> ShowS
$cshowsPrec :: Int -> UpdateFlowEntitlementResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateFlowEntitlementResponse x
-> UpdateFlowEntitlementResponse
forall x.
UpdateFlowEntitlementResponse
-> Rep UpdateFlowEntitlementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateFlowEntitlementResponse x
-> UpdateFlowEntitlementResponse
$cfrom :: forall x.
UpdateFlowEntitlementResponse
-> Rep UpdateFlowEntitlementResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlowEntitlementResponse' 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:
--
-- 'entitlement', 'updateFlowEntitlementResponse_entitlement' - The new configuration of the entitlement that you updated.
--
-- 'flowArn', 'updateFlowEntitlementResponse_flowArn' - The ARN of the flow that this entitlement was granted on.
--
-- 'httpStatus', 'updateFlowEntitlementResponse_httpStatus' - The response's http status code.
newUpdateFlowEntitlementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFlowEntitlementResponse
newUpdateFlowEntitlementResponse :: Int -> UpdateFlowEntitlementResponse
newUpdateFlowEntitlementResponse Int
pHttpStatus_ =
  UpdateFlowEntitlementResponse'
    { $sel:entitlement:UpdateFlowEntitlementResponse' :: Maybe Entitlement
entitlement =
        forall a. Maybe a
Prelude.Nothing,
      $sel:flowArn:UpdateFlowEntitlementResponse' :: Maybe Text
flowArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFlowEntitlementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The new configuration of the entitlement that you updated.
updateFlowEntitlementResponse_entitlement :: Lens.Lens' UpdateFlowEntitlementResponse (Prelude.Maybe Entitlement)
updateFlowEntitlementResponse_entitlement :: Lens' UpdateFlowEntitlementResponse (Maybe Entitlement)
updateFlowEntitlementResponse_entitlement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlementResponse' {Maybe Entitlement
entitlement :: Maybe Entitlement
$sel:entitlement:UpdateFlowEntitlementResponse' :: UpdateFlowEntitlementResponse -> Maybe Entitlement
entitlement} -> Maybe Entitlement
entitlement) (\s :: UpdateFlowEntitlementResponse
s@UpdateFlowEntitlementResponse' {} Maybe Entitlement
a -> UpdateFlowEntitlementResponse
s {$sel:entitlement:UpdateFlowEntitlementResponse' :: Maybe Entitlement
entitlement = Maybe Entitlement
a} :: UpdateFlowEntitlementResponse)

-- | The ARN of the flow that this entitlement was granted on.
updateFlowEntitlementResponse_flowArn :: Lens.Lens' UpdateFlowEntitlementResponse (Prelude.Maybe Prelude.Text)
updateFlowEntitlementResponse_flowArn :: Lens' UpdateFlowEntitlementResponse (Maybe Text)
updateFlowEntitlementResponse_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowEntitlementResponse' {Maybe Text
flowArn :: Maybe Text
$sel:flowArn:UpdateFlowEntitlementResponse' :: UpdateFlowEntitlementResponse -> Maybe Text
flowArn} -> Maybe Text
flowArn) (\s :: UpdateFlowEntitlementResponse
s@UpdateFlowEntitlementResponse' {} Maybe Text
a -> UpdateFlowEntitlementResponse
s {$sel:flowArn:UpdateFlowEntitlementResponse' :: Maybe Text
flowArn = Maybe Text
a} :: UpdateFlowEntitlementResponse)

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

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