{-# 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.MediaPackage.CreateOriginEndpoint
-- 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 a new OriginEndpoint record.
module Amazonka.MediaPackage.CreateOriginEndpoint
  ( -- * Creating a Request
    CreateOriginEndpoint (..),
    newCreateOriginEndpoint,

    -- * Request Lenses
    createOriginEndpoint_authorization,
    createOriginEndpoint_cmafPackage,
    createOriginEndpoint_dashPackage,
    createOriginEndpoint_description,
    createOriginEndpoint_hlsPackage,
    createOriginEndpoint_manifestName,
    createOriginEndpoint_mssPackage,
    createOriginEndpoint_origination,
    createOriginEndpoint_startoverWindowSeconds,
    createOriginEndpoint_tags,
    createOriginEndpoint_timeDelaySeconds,
    createOriginEndpoint_whitelist,
    createOriginEndpoint_channelId,
    createOriginEndpoint_id,

    -- * Destructuring the Response
    CreateOriginEndpointResponse (..),
    newCreateOriginEndpointResponse,

    -- * Response Lenses
    createOriginEndpointResponse_arn,
    createOriginEndpointResponse_authorization,
    createOriginEndpointResponse_channelId,
    createOriginEndpointResponse_cmafPackage,
    createOriginEndpointResponse_dashPackage,
    createOriginEndpointResponse_description,
    createOriginEndpointResponse_hlsPackage,
    createOriginEndpointResponse_id,
    createOriginEndpointResponse_manifestName,
    createOriginEndpointResponse_mssPackage,
    createOriginEndpointResponse_origination,
    createOriginEndpointResponse_startoverWindowSeconds,
    createOriginEndpointResponse_tags,
    createOriginEndpointResponse_timeDelaySeconds,
    createOriginEndpointResponse_url,
    createOriginEndpointResponse_whitelist,
    createOriginEndpointResponse_httpStatus,
  )
where

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

-- | Configuration parameters used to create a new OriginEndpoint.
--
-- /See:/ 'newCreateOriginEndpoint' smart constructor.
data CreateOriginEndpoint = CreateOriginEndpoint'
  { CreateOriginEndpoint -> Maybe Authorization
authorization :: Prelude.Maybe Authorization,
    CreateOriginEndpoint -> Maybe CmafPackageCreateOrUpdateParameters
cmafPackage :: Prelude.Maybe CmafPackageCreateOrUpdateParameters,
    CreateOriginEndpoint -> Maybe DashPackage
dashPackage :: Prelude.Maybe DashPackage,
    -- | A short text description of the OriginEndpoint.
    CreateOriginEndpoint -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpoint -> Maybe HlsPackage
hlsPackage :: Prelude.Maybe HlsPackage,
    -- | A short string that will be used as the filename of the OriginEndpoint
    -- URL (defaults to \"index\").
    CreateOriginEndpoint -> Maybe Text
manifestName :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpoint -> Maybe MssPackage
mssPackage :: Prelude.Maybe MssPackage,
    -- | Control whether origination of video is allowed for this OriginEndpoint.
    -- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
    -- other form of access control. If set to DENY, the OriginEndpoint may not
    -- be requested. This can be helpful for Live to VOD harvesting, or for
    -- temporarily disabling origination
    CreateOriginEndpoint -> Maybe Origination
origination :: Prelude.Maybe Origination,
    -- | Maximum duration (seconds) of content to retain for startover playback.
    -- If not specified, startover playback will be disabled for the
    -- OriginEndpoint.
    CreateOriginEndpoint -> Maybe Int
startoverWindowSeconds :: Prelude.Maybe Prelude.Int,
    CreateOriginEndpoint -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Amount of delay (seconds) to enforce on the playback of live content. If
    -- not specified, there will be no time delay in effect for the
    -- OriginEndpoint.
    CreateOriginEndpoint -> Maybe Int
timeDelaySeconds :: Prelude.Maybe Prelude.Int,
    -- | A list of source IP CIDR blocks that will be allowed to access the
    -- OriginEndpoint.
    CreateOriginEndpoint -> Maybe [Text]
whitelist :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the Channel that the OriginEndpoint will be associated with.
    -- This cannot be changed after the OriginEndpoint is created.
    CreateOriginEndpoint -> Text
channelId :: Prelude.Text,
    -- | The ID of the OriginEndpoint. The ID must be unique within the region
    -- and it cannot be changed after the OriginEndpoint is created.
    CreateOriginEndpoint -> Text
id :: Prelude.Text
  }
  deriving (CreateOriginEndpoint -> CreateOriginEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOriginEndpoint -> CreateOriginEndpoint -> Bool
$c/= :: CreateOriginEndpoint -> CreateOriginEndpoint -> Bool
== :: CreateOriginEndpoint -> CreateOriginEndpoint -> Bool
$c== :: CreateOriginEndpoint -> CreateOriginEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateOriginEndpoint]
ReadPrec CreateOriginEndpoint
Int -> ReadS CreateOriginEndpoint
ReadS [CreateOriginEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOriginEndpoint]
$creadListPrec :: ReadPrec [CreateOriginEndpoint]
readPrec :: ReadPrec CreateOriginEndpoint
$creadPrec :: ReadPrec CreateOriginEndpoint
readList :: ReadS [CreateOriginEndpoint]
$creadList :: ReadS [CreateOriginEndpoint]
readsPrec :: Int -> ReadS CreateOriginEndpoint
$creadsPrec :: Int -> ReadS CreateOriginEndpoint
Prelude.Read, Int -> CreateOriginEndpoint -> ShowS
[CreateOriginEndpoint] -> ShowS
CreateOriginEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOriginEndpoint] -> ShowS
$cshowList :: [CreateOriginEndpoint] -> ShowS
show :: CreateOriginEndpoint -> String
$cshow :: CreateOriginEndpoint -> String
showsPrec :: Int -> CreateOriginEndpoint -> ShowS
$cshowsPrec :: Int -> CreateOriginEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateOriginEndpoint x -> CreateOriginEndpoint
forall x. CreateOriginEndpoint -> Rep CreateOriginEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOriginEndpoint x -> CreateOriginEndpoint
$cfrom :: forall x. CreateOriginEndpoint -> Rep CreateOriginEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateOriginEndpoint' 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:
--
-- 'authorization', 'createOriginEndpoint_authorization' - Undocumented member.
--
-- 'cmafPackage', 'createOriginEndpoint_cmafPackage' - Undocumented member.
--
-- 'dashPackage', 'createOriginEndpoint_dashPackage' - Undocumented member.
--
-- 'description', 'createOriginEndpoint_description' - A short text description of the OriginEndpoint.
--
-- 'hlsPackage', 'createOriginEndpoint_hlsPackage' - Undocumented member.
--
-- 'manifestName', 'createOriginEndpoint_manifestName' - A short string that will be used as the filename of the OriginEndpoint
-- URL (defaults to \"index\").
--
-- 'mssPackage', 'createOriginEndpoint_mssPackage' - Undocumented member.
--
-- 'origination', 'createOriginEndpoint_origination' - Control whether origination of video is allowed for this OriginEndpoint.
-- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
-- other form of access control. If set to DENY, the OriginEndpoint may not
-- be requested. This can be helpful for Live to VOD harvesting, or for
-- temporarily disabling origination
--
-- 'startoverWindowSeconds', 'createOriginEndpoint_startoverWindowSeconds' - Maximum duration (seconds) of content to retain for startover playback.
-- If not specified, startover playback will be disabled for the
-- OriginEndpoint.
--
-- 'tags', 'createOriginEndpoint_tags' - Undocumented member.
--
-- 'timeDelaySeconds', 'createOriginEndpoint_timeDelaySeconds' - Amount of delay (seconds) to enforce on the playback of live content. If
-- not specified, there will be no time delay in effect for the
-- OriginEndpoint.
--
-- 'whitelist', 'createOriginEndpoint_whitelist' - A list of source IP CIDR blocks that will be allowed to access the
-- OriginEndpoint.
--
-- 'channelId', 'createOriginEndpoint_channelId' - The ID of the Channel that the OriginEndpoint will be associated with.
-- This cannot be changed after the OriginEndpoint is created.
--
-- 'id', 'createOriginEndpoint_id' - The ID of the OriginEndpoint. The ID must be unique within the region
-- and it cannot be changed after the OriginEndpoint is created.
newCreateOriginEndpoint ::
  -- | 'channelId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  CreateOriginEndpoint
newCreateOriginEndpoint :: Text -> Text -> CreateOriginEndpoint
newCreateOriginEndpoint Text
pChannelId_ Text
pId_ =
  CreateOriginEndpoint'
    { $sel:authorization:CreateOriginEndpoint' :: Maybe Authorization
authorization =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cmafPackage:CreateOriginEndpoint' :: Maybe CmafPackageCreateOrUpdateParameters
cmafPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:dashPackage:CreateOriginEndpoint' :: Maybe DashPackage
dashPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateOriginEndpoint' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:hlsPackage:CreateOriginEndpoint' :: Maybe HlsPackage
hlsPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:manifestName:CreateOriginEndpoint' :: Maybe Text
manifestName = forall a. Maybe a
Prelude.Nothing,
      $sel:mssPackage:CreateOriginEndpoint' :: Maybe MssPackage
mssPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:origination:CreateOriginEndpoint' :: Maybe Origination
origination = forall a. Maybe a
Prelude.Nothing,
      $sel:startoverWindowSeconds:CreateOriginEndpoint' :: Maybe Int
startoverWindowSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateOriginEndpoint' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeDelaySeconds:CreateOriginEndpoint' :: Maybe Int
timeDelaySeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:whitelist:CreateOriginEndpoint' :: Maybe [Text]
whitelist = forall a. Maybe a
Prelude.Nothing,
      $sel:channelId:CreateOriginEndpoint' :: Text
channelId = Text
pChannelId_,
      $sel:id:CreateOriginEndpoint' :: Text
id = Text
pId_
    }

-- | Undocumented member.
createOriginEndpoint_authorization :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Authorization)
createOriginEndpoint_authorization :: Lens' CreateOriginEndpoint (Maybe Authorization)
createOriginEndpoint_authorization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Authorization
authorization :: Maybe Authorization
$sel:authorization:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Authorization
authorization} -> Maybe Authorization
authorization) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Authorization
a -> CreateOriginEndpoint
s {$sel:authorization:CreateOriginEndpoint' :: Maybe Authorization
authorization = Maybe Authorization
a} :: CreateOriginEndpoint)

-- | Undocumented member.
createOriginEndpoint_cmafPackage :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe CmafPackageCreateOrUpdateParameters)
createOriginEndpoint_cmafPackage :: Lens'
  CreateOriginEndpoint (Maybe CmafPackageCreateOrUpdateParameters)
createOriginEndpoint_cmafPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe CmafPackageCreateOrUpdateParameters
cmafPackage :: Maybe CmafPackageCreateOrUpdateParameters
$sel:cmafPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe CmafPackageCreateOrUpdateParameters
cmafPackage} -> Maybe CmafPackageCreateOrUpdateParameters
cmafPackage) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe CmafPackageCreateOrUpdateParameters
a -> CreateOriginEndpoint
s {$sel:cmafPackage:CreateOriginEndpoint' :: Maybe CmafPackageCreateOrUpdateParameters
cmafPackage = Maybe CmafPackageCreateOrUpdateParameters
a} :: CreateOriginEndpoint)

-- | Undocumented member.
createOriginEndpoint_dashPackage :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe DashPackage)
createOriginEndpoint_dashPackage :: Lens' CreateOriginEndpoint (Maybe DashPackage)
createOriginEndpoint_dashPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe DashPackage
dashPackage :: Maybe DashPackage
$sel:dashPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe DashPackage
dashPackage} -> Maybe DashPackage
dashPackage) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe DashPackage
a -> CreateOriginEndpoint
s {$sel:dashPackage:CreateOriginEndpoint' :: Maybe DashPackage
dashPackage = Maybe DashPackage
a} :: CreateOriginEndpoint)

-- | A short text description of the OriginEndpoint.
createOriginEndpoint_description :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Prelude.Text)
createOriginEndpoint_description :: Lens' CreateOriginEndpoint (Maybe Text)
createOriginEndpoint_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Text
description :: Maybe Text
$sel:description:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Text
a -> CreateOriginEndpoint
s {$sel:description:CreateOriginEndpoint' :: Maybe Text
description = Maybe Text
a} :: CreateOriginEndpoint)

-- | Undocumented member.
createOriginEndpoint_hlsPackage :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe HlsPackage)
createOriginEndpoint_hlsPackage :: Lens' CreateOriginEndpoint (Maybe HlsPackage)
createOriginEndpoint_hlsPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe HlsPackage
hlsPackage :: Maybe HlsPackage
$sel:hlsPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe HlsPackage
hlsPackage} -> Maybe HlsPackage
hlsPackage) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe HlsPackage
a -> CreateOriginEndpoint
s {$sel:hlsPackage:CreateOriginEndpoint' :: Maybe HlsPackage
hlsPackage = Maybe HlsPackage
a} :: CreateOriginEndpoint)

-- | A short string that will be used as the filename of the OriginEndpoint
-- URL (defaults to \"index\").
createOriginEndpoint_manifestName :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Prelude.Text)
createOriginEndpoint_manifestName :: Lens' CreateOriginEndpoint (Maybe Text)
createOriginEndpoint_manifestName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Text
manifestName :: Maybe Text
$sel:manifestName:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
manifestName} -> Maybe Text
manifestName) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Text
a -> CreateOriginEndpoint
s {$sel:manifestName:CreateOriginEndpoint' :: Maybe Text
manifestName = Maybe Text
a} :: CreateOriginEndpoint)

-- | Undocumented member.
createOriginEndpoint_mssPackage :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe MssPackage)
createOriginEndpoint_mssPackage :: Lens' CreateOriginEndpoint (Maybe MssPackage)
createOriginEndpoint_mssPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe MssPackage
mssPackage :: Maybe MssPackage
$sel:mssPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe MssPackage
mssPackage} -> Maybe MssPackage
mssPackage) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe MssPackage
a -> CreateOriginEndpoint
s {$sel:mssPackage:CreateOriginEndpoint' :: Maybe MssPackage
mssPackage = Maybe MssPackage
a} :: CreateOriginEndpoint)

-- | Control whether origination of video is allowed for this OriginEndpoint.
-- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
-- other form of access control. If set to DENY, the OriginEndpoint may not
-- be requested. This can be helpful for Live to VOD harvesting, or for
-- temporarily disabling origination
createOriginEndpoint_origination :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Origination)
createOriginEndpoint_origination :: Lens' CreateOriginEndpoint (Maybe Origination)
createOriginEndpoint_origination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Origination
origination :: Maybe Origination
$sel:origination:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Origination
origination} -> Maybe Origination
origination) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Origination
a -> CreateOriginEndpoint
s {$sel:origination:CreateOriginEndpoint' :: Maybe Origination
origination = Maybe Origination
a} :: CreateOriginEndpoint)

-- | Maximum duration (seconds) of content to retain for startover playback.
-- If not specified, startover playback will be disabled for the
-- OriginEndpoint.
createOriginEndpoint_startoverWindowSeconds :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Prelude.Int)
createOriginEndpoint_startoverWindowSeconds :: Lens' CreateOriginEndpoint (Maybe Int)
createOriginEndpoint_startoverWindowSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Int
startoverWindowSeconds :: Maybe Int
$sel:startoverWindowSeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
startoverWindowSeconds} -> Maybe Int
startoverWindowSeconds) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Int
a -> CreateOriginEndpoint
s {$sel:startoverWindowSeconds:CreateOriginEndpoint' :: Maybe Int
startoverWindowSeconds = Maybe Int
a} :: CreateOriginEndpoint)

-- | Undocumented member.
createOriginEndpoint_tags :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createOriginEndpoint_tags :: Lens' CreateOriginEndpoint (Maybe (HashMap Text Text))
createOriginEndpoint_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe (HashMap Text Text)
a -> CreateOriginEndpoint
s {$sel:tags:CreateOriginEndpoint' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateOriginEndpoint) 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

-- | Amount of delay (seconds) to enforce on the playback of live content. If
-- not specified, there will be no time delay in effect for the
-- OriginEndpoint.
createOriginEndpoint_timeDelaySeconds :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe Prelude.Int)
createOriginEndpoint_timeDelaySeconds :: Lens' CreateOriginEndpoint (Maybe Int)
createOriginEndpoint_timeDelaySeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe Int
timeDelaySeconds :: Maybe Int
$sel:timeDelaySeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
timeDelaySeconds} -> Maybe Int
timeDelaySeconds) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe Int
a -> CreateOriginEndpoint
s {$sel:timeDelaySeconds:CreateOriginEndpoint' :: Maybe Int
timeDelaySeconds = Maybe Int
a} :: CreateOriginEndpoint)

-- | A list of source IP CIDR blocks that will be allowed to access the
-- OriginEndpoint.
createOriginEndpoint_whitelist :: Lens.Lens' CreateOriginEndpoint (Prelude.Maybe [Prelude.Text])
createOriginEndpoint_whitelist :: Lens' CreateOriginEndpoint (Maybe [Text])
createOriginEndpoint_whitelist = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Maybe [Text]
whitelist :: Maybe [Text]
$sel:whitelist:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe [Text]
whitelist} -> Maybe [Text]
whitelist) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Maybe [Text]
a -> CreateOriginEndpoint
s {$sel:whitelist:CreateOriginEndpoint' :: Maybe [Text]
whitelist = Maybe [Text]
a} :: CreateOriginEndpoint) 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 ID of the Channel that the OriginEndpoint will be associated with.
-- This cannot be changed after the OriginEndpoint is created.
createOriginEndpoint_channelId :: Lens.Lens' CreateOriginEndpoint Prelude.Text
createOriginEndpoint_channelId :: Lens' CreateOriginEndpoint Text
createOriginEndpoint_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Text
channelId :: Text
$sel:channelId:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
channelId} -> Text
channelId) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Text
a -> CreateOriginEndpoint
s {$sel:channelId:CreateOriginEndpoint' :: Text
channelId = Text
a} :: CreateOriginEndpoint)

-- | The ID of the OriginEndpoint. The ID must be unique within the region
-- and it cannot be changed after the OriginEndpoint is created.
createOriginEndpoint_id :: Lens.Lens' CreateOriginEndpoint Prelude.Text
createOriginEndpoint_id :: Lens' CreateOriginEndpoint Text
createOriginEndpoint_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpoint' {Text
id :: Text
$sel:id:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
id} -> Text
id) (\s :: CreateOriginEndpoint
s@CreateOriginEndpoint' {} Text
a -> CreateOriginEndpoint
s {$sel:id:CreateOriginEndpoint' :: Text
id = Text
a} :: CreateOriginEndpoint)

instance Core.AWSRequest CreateOriginEndpoint where
  type
    AWSResponse CreateOriginEndpoint =
      CreateOriginEndpointResponse
  request :: (Service -> Service)
-> CreateOriginEndpoint -> Request CreateOriginEndpoint
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 CreateOriginEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateOriginEndpoint)))
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
-> Maybe Authorization
-> Maybe Text
-> Maybe CmafPackage
-> Maybe DashPackage
-> Maybe Text
-> Maybe HlsPackage
-> Maybe Text
-> Maybe Text
-> Maybe MssPackage
-> Maybe Origination
-> Maybe Int
-> Maybe (HashMap Text Text)
-> Maybe Int
-> Maybe Text
-> Maybe [Text]
-> Int
-> CreateOriginEndpointResponse
CreateOriginEndpointResponse'
            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
"arn")
            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
"authorization")
            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
"channelId")
            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
"cmafPackage")
            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
"dashPackage")
            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
"description")
            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
"hlsPackage")
            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
"id")
            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
"manifestName")
            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
"mssPackage")
            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
"origination")
            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
"startoverWindowSeconds")
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"timeDelaySeconds")
            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
"url")
            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
"whitelist" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateOriginEndpoint where
  hashWithSalt :: Int -> CreateOriginEndpoint -> Int
hashWithSalt Int
_salt CreateOriginEndpoint' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe Authorization
Maybe Origination
Maybe MssPackage
Maybe HlsPackage
Maybe CmafPackageCreateOrUpdateParameters
Maybe DashPackage
Text
id :: Text
channelId :: Text
whitelist :: Maybe [Text]
timeDelaySeconds :: Maybe Int
tags :: Maybe (HashMap Text Text)
startoverWindowSeconds :: Maybe Int
origination :: Maybe Origination
mssPackage :: Maybe MssPackage
manifestName :: Maybe Text
hlsPackage :: Maybe HlsPackage
description :: Maybe Text
dashPackage :: Maybe DashPackage
cmafPackage :: Maybe CmafPackageCreateOrUpdateParameters
authorization :: Maybe Authorization
$sel:id:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:channelId:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:whitelist:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe [Text]
$sel:timeDelaySeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:tags:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe (HashMap Text Text)
$sel:startoverWindowSeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:origination:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Origination
$sel:mssPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe MssPackage
$sel:manifestName:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:hlsPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe HlsPackage
$sel:description:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:dashPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe DashPackage
$sel:cmafPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe CmafPackageCreateOrUpdateParameters
$sel:authorization:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Authorization
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Authorization
authorization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CmafPackageCreateOrUpdateParameters
cmafPackage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DashPackage
dashPackage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsPackage
hlsPackage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
manifestName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MssPackage
mssPackage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Origination
origination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
startoverWindowSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
timeDelaySeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
whitelist
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData CreateOriginEndpoint where
  rnf :: CreateOriginEndpoint -> ()
rnf CreateOriginEndpoint' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe Authorization
Maybe Origination
Maybe MssPackage
Maybe HlsPackage
Maybe CmafPackageCreateOrUpdateParameters
Maybe DashPackage
Text
id :: Text
channelId :: Text
whitelist :: Maybe [Text]
timeDelaySeconds :: Maybe Int
tags :: Maybe (HashMap Text Text)
startoverWindowSeconds :: Maybe Int
origination :: Maybe Origination
mssPackage :: Maybe MssPackage
manifestName :: Maybe Text
hlsPackage :: Maybe HlsPackage
description :: Maybe Text
dashPackage :: Maybe DashPackage
cmafPackage :: Maybe CmafPackageCreateOrUpdateParameters
authorization :: Maybe Authorization
$sel:id:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:channelId:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:whitelist:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe [Text]
$sel:timeDelaySeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:tags:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe (HashMap Text Text)
$sel:startoverWindowSeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:origination:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Origination
$sel:mssPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe MssPackage
$sel:manifestName:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:hlsPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe HlsPackage
$sel:description:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:dashPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe DashPackage
$sel:cmafPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe CmafPackageCreateOrUpdateParameters
$sel:authorization:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Authorization
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Authorization
authorization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CmafPackageCreateOrUpdateParameters
cmafPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DashPackage
dashPackage
      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 HlsPackage
hlsPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
manifestName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MssPackage
mssPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Origination
origination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
startoverWindowSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
timeDelaySeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
whitelist
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders CreateOriginEndpoint where
  toHeaders :: CreateOriginEndpoint -> 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 CreateOriginEndpoint where
  toJSON :: CreateOriginEndpoint -> Value
toJSON CreateOriginEndpoint' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe Authorization
Maybe Origination
Maybe MssPackage
Maybe HlsPackage
Maybe CmafPackageCreateOrUpdateParameters
Maybe DashPackage
Text
id :: Text
channelId :: Text
whitelist :: Maybe [Text]
timeDelaySeconds :: Maybe Int
tags :: Maybe (HashMap Text Text)
startoverWindowSeconds :: Maybe Int
origination :: Maybe Origination
mssPackage :: Maybe MssPackage
manifestName :: Maybe Text
hlsPackage :: Maybe HlsPackage
description :: Maybe Text
dashPackage :: Maybe DashPackage
cmafPackage :: Maybe CmafPackageCreateOrUpdateParameters
authorization :: Maybe Authorization
$sel:id:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:channelId:CreateOriginEndpoint' :: CreateOriginEndpoint -> Text
$sel:whitelist:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe [Text]
$sel:timeDelaySeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:tags:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe (HashMap Text Text)
$sel:startoverWindowSeconds:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Int
$sel:origination:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Origination
$sel:mssPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe MssPackage
$sel:manifestName:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:hlsPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe HlsPackage
$sel:description:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Text
$sel:dashPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe DashPackage
$sel:cmafPackage:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe CmafPackageCreateOrUpdateParameters
$sel:authorization:CreateOriginEndpoint' :: CreateOriginEndpoint -> Maybe Authorization
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authorization" 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 Authorization
authorization,
            (Key
"cmafPackage" 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 CmafPackageCreateOrUpdateParameters
cmafPackage,
            (Key
"dashPackage" 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 DashPackage
dashPackage,
            (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
"hlsPackage" 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 HlsPackage
hlsPackage,
            (Key
"manifestName" 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
manifestName,
            (Key
"mssPackage" 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 MssPackage
mssPackage,
            (Key
"origination" 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 Origination
origination,
            (Key
"startoverWindowSeconds" 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 Int
startoverWindowSeconds,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            (Key
"timeDelaySeconds" 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 Int
timeDelaySeconds,
            (Key
"whitelist" 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]
whitelist,
            forall a. a -> Maybe a
Prelude.Just (Key
"channelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelId),
            forall a. a -> Maybe a
Prelude.Just (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

-- | /See:/ 'newCreateOriginEndpointResponse' smart constructor.
data CreateOriginEndpointResponse = CreateOriginEndpointResponse'
  { -- | The Amazon Resource Name (ARN) assigned to the OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpointResponse -> Maybe Authorization
authorization :: Prelude.Maybe Authorization,
    -- | The ID of the Channel the OriginEndpoint is associated with.
    CreateOriginEndpointResponse -> Maybe Text
channelId :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpointResponse -> Maybe CmafPackage
cmafPackage :: Prelude.Maybe CmafPackage,
    CreateOriginEndpointResponse -> Maybe DashPackage
dashPackage :: Prelude.Maybe DashPackage,
    -- | A short text description of the OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpointResponse -> Maybe HlsPackage
hlsPackage :: Prelude.Maybe HlsPackage,
    -- | The ID of the OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | A short string appended to the end of the OriginEndpoint URL.
    CreateOriginEndpointResponse -> Maybe Text
manifestName :: Prelude.Maybe Prelude.Text,
    CreateOriginEndpointResponse -> Maybe MssPackage
mssPackage :: Prelude.Maybe MssPackage,
    -- | Control whether origination of video is allowed for this OriginEndpoint.
    -- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
    -- other form of access control. If set to DENY, the OriginEndpoint may not
    -- be requested. This can be helpful for Live to VOD harvesting, or for
    -- temporarily disabling origination
    CreateOriginEndpointResponse -> Maybe Origination
origination :: Prelude.Maybe Origination,
    -- | Maximum duration (seconds) of content to retain for startover playback.
    -- If not specified, startover playback will be disabled for the
    -- OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe Int
startoverWindowSeconds :: Prelude.Maybe Prelude.Int,
    CreateOriginEndpointResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Amount of delay (seconds) to enforce on the playback of live content. If
    -- not specified, there will be no time delay in effect for the
    -- OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe Int
timeDelaySeconds :: Prelude.Maybe Prelude.Int,
    -- | The URL of the packaged OriginEndpoint for consumption.
    CreateOriginEndpointResponse -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | A list of source IP CIDR blocks that will be allowed to access the
    -- OriginEndpoint.
    CreateOriginEndpointResponse -> Maybe [Text]
whitelist :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    CreateOriginEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateOriginEndpointResponse
-> CreateOriginEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOriginEndpointResponse
-> CreateOriginEndpointResponse -> Bool
$c/= :: CreateOriginEndpointResponse
-> CreateOriginEndpointResponse -> Bool
== :: CreateOriginEndpointResponse
-> CreateOriginEndpointResponse -> Bool
$c== :: CreateOriginEndpointResponse
-> CreateOriginEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateOriginEndpointResponse]
ReadPrec CreateOriginEndpointResponse
Int -> ReadS CreateOriginEndpointResponse
ReadS [CreateOriginEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOriginEndpointResponse]
$creadListPrec :: ReadPrec [CreateOriginEndpointResponse]
readPrec :: ReadPrec CreateOriginEndpointResponse
$creadPrec :: ReadPrec CreateOriginEndpointResponse
readList :: ReadS [CreateOriginEndpointResponse]
$creadList :: ReadS [CreateOriginEndpointResponse]
readsPrec :: Int -> ReadS CreateOriginEndpointResponse
$creadsPrec :: Int -> ReadS CreateOriginEndpointResponse
Prelude.Read, Int -> CreateOriginEndpointResponse -> ShowS
[CreateOriginEndpointResponse] -> ShowS
CreateOriginEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOriginEndpointResponse] -> ShowS
$cshowList :: [CreateOriginEndpointResponse] -> ShowS
show :: CreateOriginEndpointResponse -> String
$cshow :: CreateOriginEndpointResponse -> String
showsPrec :: Int -> CreateOriginEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateOriginEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateOriginEndpointResponse x -> CreateOriginEndpointResponse
forall x.
CreateOriginEndpointResponse -> Rep CreateOriginEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateOriginEndpointResponse x -> CreateOriginEndpointResponse
$cfrom :: forall x.
CreateOriginEndpointResponse -> Rep CreateOriginEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateOriginEndpointResponse' 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:
--
-- 'arn', 'createOriginEndpointResponse_arn' - The Amazon Resource Name (ARN) assigned to the OriginEndpoint.
--
-- 'authorization', 'createOriginEndpointResponse_authorization' - Undocumented member.
--
-- 'channelId', 'createOriginEndpointResponse_channelId' - The ID of the Channel the OriginEndpoint is associated with.
--
-- 'cmafPackage', 'createOriginEndpointResponse_cmafPackage' - Undocumented member.
--
-- 'dashPackage', 'createOriginEndpointResponse_dashPackage' - Undocumented member.
--
-- 'description', 'createOriginEndpointResponse_description' - A short text description of the OriginEndpoint.
--
-- 'hlsPackage', 'createOriginEndpointResponse_hlsPackage' - Undocumented member.
--
-- 'id', 'createOriginEndpointResponse_id' - The ID of the OriginEndpoint.
--
-- 'manifestName', 'createOriginEndpointResponse_manifestName' - A short string appended to the end of the OriginEndpoint URL.
--
-- 'mssPackage', 'createOriginEndpointResponse_mssPackage' - Undocumented member.
--
-- 'origination', 'createOriginEndpointResponse_origination' - Control whether origination of video is allowed for this OriginEndpoint.
-- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
-- other form of access control. If set to DENY, the OriginEndpoint may not
-- be requested. This can be helpful for Live to VOD harvesting, or for
-- temporarily disabling origination
--
-- 'startoverWindowSeconds', 'createOriginEndpointResponse_startoverWindowSeconds' - Maximum duration (seconds) of content to retain for startover playback.
-- If not specified, startover playback will be disabled for the
-- OriginEndpoint.
--
-- 'tags', 'createOriginEndpointResponse_tags' - Undocumented member.
--
-- 'timeDelaySeconds', 'createOriginEndpointResponse_timeDelaySeconds' - Amount of delay (seconds) to enforce on the playback of live content. If
-- not specified, there will be no time delay in effect for the
-- OriginEndpoint.
--
-- 'url', 'createOriginEndpointResponse_url' - The URL of the packaged OriginEndpoint for consumption.
--
-- 'whitelist', 'createOriginEndpointResponse_whitelist' - A list of source IP CIDR blocks that will be allowed to access the
-- OriginEndpoint.
--
-- 'httpStatus', 'createOriginEndpointResponse_httpStatus' - The response's http status code.
newCreateOriginEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOriginEndpointResponse
newCreateOriginEndpointResponse :: Int -> CreateOriginEndpointResponse
newCreateOriginEndpointResponse Int
pHttpStatus_ =
  CreateOriginEndpointResponse'
    { $sel:arn:CreateOriginEndpointResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:authorization:CreateOriginEndpointResponse' :: Maybe Authorization
authorization = forall a. Maybe a
Prelude.Nothing,
      $sel:channelId:CreateOriginEndpointResponse' :: Maybe Text
channelId = forall a. Maybe a
Prelude.Nothing,
      $sel:cmafPackage:CreateOriginEndpointResponse' :: Maybe CmafPackage
cmafPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:dashPackage:CreateOriginEndpointResponse' :: Maybe DashPackage
dashPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateOriginEndpointResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:hlsPackage:CreateOriginEndpointResponse' :: Maybe HlsPackage
hlsPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateOriginEndpointResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:manifestName:CreateOriginEndpointResponse' :: Maybe Text
manifestName = forall a. Maybe a
Prelude.Nothing,
      $sel:mssPackage:CreateOriginEndpointResponse' :: Maybe MssPackage
mssPackage = forall a. Maybe a
Prelude.Nothing,
      $sel:origination:CreateOriginEndpointResponse' :: Maybe Origination
origination = forall a. Maybe a
Prelude.Nothing,
      $sel:startoverWindowSeconds:CreateOriginEndpointResponse' :: Maybe Int
startoverWindowSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateOriginEndpointResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeDelaySeconds:CreateOriginEndpointResponse' :: Maybe Int
timeDelaySeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:url:CreateOriginEndpointResponse' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:whitelist:CreateOriginEndpointResponse' :: Maybe [Text]
whitelist = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOriginEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) assigned to the OriginEndpoint.
createOriginEndpointResponse_arn :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_arn :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:arn:CreateOriginEndpointResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_authorization :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Authorization)
createOriginEndpointResponse_authorization :: Lens' CreateOriginEndpointResponse (Maybe Authorization)
createOriginEndpointResponse_authorization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Authorization
authorization :: Maybe Authorization
$sel:authorization:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Authorization
authorization} -> Maybe Authorization
authorization) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Authorization
a -> CreateOriginEndpointResponse
s {$sel:authorization:CreateOriginEndpointResponse' :: Maybe Authorization
authorization = Maybe Authorization
a} :: CreateOriginEndpointResponse)

-- | The ID of the Channel the OriginEndpoint is associated with.
createOriginEndpointResponse_channelId :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_channelId :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
channelId :: Maybe Text
$sel:channelId:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
channelId} -> Maybe Text
channelId) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:channelId:CreateOriginEndpointResponse' :: Maybe Text
channelId = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_cmafPackage :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe CmafPackage)
createOriginEndpointResponse_cmafPackage :: Lens' CreateOriginEndpointResponse (Maybe CmafPackage)
createOriginEndpointResponse_cmafPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe CmafPackage
cmafPackage :: Maybe CmafPackage
$sel:cmafPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe CmafPackage
cmafPackage} -> Maybe CmafPackage
cmafPackage) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe CmafPackage
a -> CreateOriginEndpointResponse
s {$sel:cmafPackage:CreateOriginEndpointResponse' :: Maybe CmafPackage
cmafPackage = Maybe CmafPackage
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_dashPackage :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe DashPackage)
createOriginEndpointResponse_dashPackage :: Lens' CreateOriginEndpointResponse (Maybe DashPackage)
createOriginEndpointResponse_dashPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe DashPackage
dashPackage :: Maybe DashPackage
$sel:dashPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe DashPackage
dashPackage} -> Maybe DashPackage
dashPackage) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe DashPackage
a -> CreateOriginEndpointResponse
s {$sel:dashPackage:CreateOriginEndpointResponse' :: Maybe DashPackage
dashPackage = Maybe DashPackage
a} :: CreateOriginEndpointResponse)

-- | A short text description of the OriginEndpoint.
createOriginEndpointResponse_description :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_description :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:description:CreateOriginEndpointResponse' :: Maybe Text
description = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_hlsPackage :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe HlsPackage)
createOriginEndpointResponse_hlsPackage :: Lens' CreateOriginEndpointResponse (Maybe HlsPackage)
createOriginEndpointResponse_hlsPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe HlsPackage
hlsPackage :: Maybe HlsPackage
$sel:hlsPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe HlsPackage
hlsPackage} -> Maybe HlsPackage
hlsPackage) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe HlsPackage
a -> CreateOriginEndpointResponse
s {$sel:hlsPackage:CreateOriginEndpointResponse' :: Maybe HlsPackage
hlsPackage = Maybe HlsPackage
a} :: CreateOriginEndpointResponse)

-- | The ID of the OriginEndpoint.
createOriginEndpointResponse_id :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_id :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:id:CreateOriginEndpointResponse' :: Maybe Text
id = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | A short string appended to the end of the OriginEndpoint URL.
createOriginEndpointResponse_manifestName :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_manifestName :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_manifestName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
manifestName :: Maybe Text
$sel:manifestName:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
manifestName} -> Maybe Text
manifestName) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:manifestName:CreateOriginEndpointResponse' :: Maybe Text
manifestName = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_mssPackage :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe MssPackage)
createOriginEndpointResponse_mssPackage :: Lens' CreateOriginEndpointResponse (Maybe MssPackage)
createOriginEndpointResponse_mssPackage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe MssPackage
mssPackage :: Maybe MssPackage
$sel:mssPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe MssPackage
mssPackage} -> Maybe MssPackage
mssPackage) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe MssPackage
a -> CreateOriginEndpointResponse
s {$sel:mssPackage:CreateOriginEndpointResponse' :: Maybe MssPackage
mssPackage = Maybe MssPackage
a} :: CreateOriginEndpointResponse)

-- | Control whether origination of video is allowed for this OriginEndpoint.
-- If set to ALLOW, the OriginEndpoint may by requested, pursuant to any
-- other form of access control. If set to DENY, the OriginEndpoint may not
-- be requested. This can be helpful for Live to VOD harvesting, or for
-- temporarily disabling origination
createOriginEndpointResponse_origination :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Origination)
createOriginEndpointResponse_origination :: Lens' CreateOriginEndpointResponse (Maybe Origination)
createOriginEndpointResponse_origination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Origination
origination :: Maybe Origination
$sel:origination:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Origination
origination} -> Maybe Origination
origination) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Origination
a -> CreateOriginEndpointResponse
s {$sel:origination:CreateOriginEndpointResponse' :: Maybe Origination
origination = Maybe Origination
a} :: CreateOriginEndpointResponse)

-- | Maximum duration (seconds) of content to retain for startover playback.
-- If not specified, startover playback will be disabled for the
-- OriginEndpoint.
createOriginEndpointResponse_startoverWindowSeconds :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Int)
createOriginEndpointResponse_startoverWindowSeconds :: Lens' CreateOriginEndpointResponse (Maybe Int)
createOriginEndpointResponse_startoverWindowSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Int
startoverWindowSeconds :: Maybe Int
$sel:startoverWindowSeconds:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Int
startoverWindowSeconds} -> Maybe Int
startoverWindowSeconds) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Int
a -> CreateOriginEndpointResponse
s {$sel:startoverWindowSeconds:CreateOriginEndpointResponse' :: Maybe Int
startoverWindowSeconds = Maybe Int
a} :: CreateOriginEndpointResponse)

-- | Undocumented member.
createOriginEndpointResponse_tags :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createOriginEndpointResponse_tags :: Lens' CreateOriginEndpointResponse (Maybe (HashMap Text Text))
createOriginEndpointResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe (HashMap Text Text)
a -> CreateOriginEndpointResponse
s {$sel:tags:CreateOriginEndpointResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateOriginEndpointResponse) 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

-- | Amount of delay (seconds) to enforce on the playback of live content. If
-- not specified, there will be no time delay in effect for the
-- OriginEndpoint.
createOriginEndpointResponse_timeDelaySeconds :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Int)
createOriginEndpointResponse_timeDelaySeconds :: Lens' CreateOriginEndpointResponse (Maybe Int)
createOriginEndpointResponse_timeDelaySeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Int
timeDelaySeconds :: Maybe Int
$sel:timeDelaySeconds:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Int
timeDelaySeconds} -> Maybe Int
timeDelaySeconds) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Int
a -> CreateOriginEndpointResponse
s {$sel:timeDelaySeconds:CreateOriginEndpointResponse' :: Maybe Int
timeDelaySeconds = Maybe Int
a} :: CreateOriginEndpointResponse)

-- | The URL of the packaged OriginEndpoint for consumption.
createOriginEndpointResponse_url :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe Prelude.Text)
createOriginEndpointResponse_url :: Lens' CreateOriginEndpointResponse (Maybe Text)
createOriginEndpointResponse_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe Text
url :: Maybe Text
$sel:url:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
url} -> Maybe Text
url) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe Text
a -> CreateOriginEndpointResponse
s {$sel:url:CreateOriginEndpointResponse' :: Maybe Text
url = Maybe Text
a} :: CreateOriginEndpointResponse)

-- | A list of source IP CIDR blocks that will be allowed to access the
-- OriginEndpoint.
createOriginEndpointResponse_whitelist :: Lens.Lens' CreateOriginEndpointResponse (Prelude.Maybe [Prelude.Text])
createOriginEndpointResponse_whitelist :: Lens' CreateOriginEndpointResponse (Maybe [Text])
createOriginEndpointResponse_whitelist = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Maybe [Text]
whitelist :: Maybe [Text]
$sel:whitelist:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe [Text]
whitelist} -> Maybe [Text]
whitelist) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Maybe [Text]
a -> CreateOriginEndpointResponse
s {$sel:whitelist:CreateOriginEndpointResponse' :: Maybe [Text]
whitelist = Maybe [Text]
a} :: CreateOriginEndpointResponse) 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 response's http status code.
createOriginEndpointResponse_httpStatus :: Lens.Lens' CreateOriginEndpointResponse Prelude.Int
createOriginEndpointResponse_httpStatus :: Lens' CreateOriginEndpointResponse Int
createOriginEndpointResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOriginEndpointResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateOriginEndpointResponse
s@CreateOriginEndpointResponse' {} Int
a -> CreateOriginEndpointResponse
s {$sel:httpStatus:CreateOriginEndpointResponse' :: Int
httpStatus = Int
a} :: CreateOriginEndpointResponse)

instance Prelude.NFData CreateOriginEndpointResponse where
  rnf :: CreateOriginEndpointResponse -> ()
rnf CreateOriginEndpointResponse' {Int
Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe Authorization
Maybe Origination
Maybe MssPackage
Maybe HlsPackage
Maybe CmafPackage
Maybe DashPackage
httpStatus :: Int
whitelist :: Maybe [Text]
url :: Maybe Text
timeDelaySeconds :: Maybe Int
tags :: Maybe (HashMap Text Text)
startoverWindowSeconds :: Maybe Int
origination :: Maybe Origination
mssPackage :: Maybe MssPackage
manifestName :: Maybe Text
id :: Maybe Text
hlsPackage :: Maybe HlsPackage
description :: Maybe Text
dashPackage :: Maybe DashPackage
cmafPackage :: Maybe CmafPackage
channelId :: Maybe Text
authorization :: Maybe Authorization
arn :: Maybe Text
$sel:httpStatus:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Int
$sel:whitelist:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe [Text]
$sel:url:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
$sel:timeDelaySeconds:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Int
$sel:tags:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe (HashMap Text Text)
$sel:startoverWindowSeconds:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Int
$sel:origination:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Origination
$sel:mssPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe MssPackage
$sel:manifestName:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
$sel:id:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
$sel:hlsPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe HlsPackage
$sel:description:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
$sel:dashPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe DashPackage
$sel:cmafPackage:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe CmafPackage
$sel:channelId:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
$sel:authorization:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Authorization
$sel:arn:CreateOriginEndpointResponse' :: CreateOriginEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Authorization
authorization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CmafPackage
cmafPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DashPackage
dashPackage
      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 HlsPackage
hlsPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
manifestName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MssPackage
mssPackage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Origination
origination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
startoverWindowSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
timeDelaySeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
whitelist
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus