{-# 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.CreateHarvestJob
-- 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 HarvestJob record.
module Amazonka.MediaPackage.CreateHarvestJob
  ( -- * Creating a Request
    CreateHarvestJob (..),
    newCreateHarvestJob,

    -- * Request Lenses
    createHarvestJob_s3Destination,
    createHarvestJob_endTime,
    createHarvestJob_originEndpointId,
    createHarvestJob_startTime,
    createHarvestJob_id,

    -- * Destructuring the Response
    CreateHarvestJobResponse (..),
    newCreateHarvestJobResponse,

    -- * Response Lenses
    createHarvestJobResponse_arn,
    createHarvestJobResponse_channelId,
    createHarvestJobResponse_createdAt,
    createHarvestJobResponse_endTime,
    createHarvestJobResponse_id,
    createHarvestJobResponse_originEndpointId,
    createHarvestJobResponse_s3Destination,
    createHarvestJobResponse_startTime,
    createHarvestJobResponse_status,
    createHarvestJobResponse_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 HarvestJob.
--
-- /See:/ 'newCreateHarvestJob' smart constructor.
data CreateHarvestJob = CreateHarvestJob'
  { CreateHarvestJob -> S3Destination
s3Destination :: S3Destination,
    -- | The end of the time-window which will be harvested
    CreateHarvestJob -> Text
endTime :: Prelude.Text,
    -- | The ID of the OriginEndpoint that the HarvestJob will harvest from. This
    -- cannot be changed after the HarvestJob is submitted.
    CreateHarvestJob -> Text
originEndpointId :: Prelude.Text,
    -- | The start of the time-window which will be harvested
    CreateHarvestJob -> Text
startTime :: Prelude.Text,
    -- | The ID of the HarvestJob. The ID must be unique within the region and it
    -- cannot be changed after the HarvestJob is submitted
    CreateHarvestJob -> Text
id :: Prelude.Text
  }
  deriving (CreateHarvestJob -> CreateHarvestJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHarvestJob -> CreateHarvestJob -> Bool
$c/= :: CreateHarvestJob -> CreateHarvestJob -> Bool
== :: CreateHarvestJob -> CreateHarvestJob -> Bool
$c== :: CreateHarvestJob -> CreateHarvestJob -> Bool
Prelude.Eq, ReadPrec [CreateHarvestJob]
ReadPrec CreateHarvestJob
Int -> ReadS CreateHarvestJob
ReadS [CreateHarvestJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHarvestJob]
$creadListPrec :: ReadPrec [CreateHarvestJob]
readPrec :: ReadPrec CreateHarvestJob
$creadPrec :: ReadPrec CreateHarvestJob
readList :: ReadS [CreateHarvestJob]
$creadList :: ReadS [CreateHarvestJob]
readsPrec :: Int -> ReadS CreateHarvestJob
$creadsPrec :: Int -> ReadS CreateHarvestJob
Prelude.Read, Int -> CreateHarvestJob -> ShowS
[CreateHarvestJob] -> ShowS
CreateHarvestJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHarvestJob] -> ShowS
$cshowList :: [CreateHarvestJob] -> ShowS
show :: CreateHarvestJob -> String
$cshow :: CreateHarvestJob -> String
showsPrec :: Int -> CreateHarvestJob -> ShowS
$cshowsPrec :: Int -> CreateHarvestJob -> ShowS
Prelude.Show, forall x. Rep CreateHarvestJob x -> CreateHarvestJob
forall x. CreateHarvestJob -> Rep CreateHarvestJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHarvestJob x -> CreateHarvestJob
$cfrom :: forall x. CreateHarvestJob -> Rep CreateHarvestJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateHarvestJob' 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:
--
-- 's3Destination', 'createHarvestJob_s3Destination' - Undocumented member.
--
-- 'endTime', 'createHarvestJob_endTime' - The end of the time-window which will be harvested
--
-- 'originEndpointId', 'createHarvestJob_originEndpointId' - The ID of the OriginEndpoint that the HarvestJob will harvest from. This
-- cannot be changed after the HarvestJob is submitted.
--
-- 'startTime', 'createHarvestJob_startTime' - The start of the time-window which will be harvested
--
-- 'id', 'createHarvestJob_id' - The ID of the HarvestJob. The ID must be unique within the region and it
-- cannot be changed after the HarvestJob is submitted
newCreateHarvestJob ::
  -- | 's3Destination'
  S3Destination ->
  -- | 'endTime'
  Prelude.Text ->
  -- | 'originEndpointId'
  Prelude.Text ->
  -- | 'startTime'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  CreateHarvestJob
newCreateHarvestJob :: S3Destination -> Text -> Text -> Text -> Text -> CreateHarvestJob
newCreateHarvestJob
  S3Destination
pS3Destination_
  Text
pEndTime_
  Text
pOriginEndpointId_
  Text
pStartTime_
  Text
pId_ =
    CreateHarvestJob'
      { $sel:s3Destination:CreateHarvestJob' :: S3Destination
s3Destination = S3Destination
pS3Destination_,
        $sel:endTime:CreateHarvestJob' :: Text
endTime = Text
pEndTime_,
        $sel:originEndpointId:CreateHarvestJob' :: Text
originEndpointId = Text
pOriginEndpointId_,
        $sel:startTime:CreateHarvestJob' :: Text
startTime = Text
pStartTime_,
        $sel:id:CreateHarvestJob' :: Text
id = Text
pId_
      }

-- | Undocumented member.
createHarvestJob_s3Destination :: Lens.Lens' CreateHarvestJob S3Destination
createHarvestJob_s3Destination :: Lens' CreateHarvestJob S3Destination
createHarvestJob_s3Destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJob' {S3Destination
s3Destination :: S3Destination
$sel:s3Destination:CreateHarvestJob' :: CreateHarvestJob -> S3Destination
s3Destination} -> S3Destination
s3Destination) (\s :: CreateHarvestJob
s@CreateHarvestJob' {} S3Destination
a -> CreateHarvestJob
s {$sel:s3Destination:CreateHarvestJob' :: S3Destination
s3Destination = S3Destination
a} :: CreateHarvestJob)

-- | The end of the time-window which will be harvested
createHarvestJob_endTime :: Lens.Lens' CreateHarvestJob Prelude.Text
createHarvestJob_endTime :: Lens' CreateHarvestJob Text
createHarvestJob_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJob' {Text
endTime :: Text
$sel:endTime:CreateHarvestJob' :: CreateHarvestJob -> Text
endTime} -> Text
endTime) (\s :: CreateHarvestJob
s@CreateHarvestJob' {} Text
a -> CreateHarvestJob
s {$sel:endTime:CreateHarvestJob' :: Text
endTime = Text
a} :: CreateHarvestJob)

-- | The ID of the OriginEndpoint that the HarvestJob will harvest from. This
-- cannot be changed after the HarvestJob is submitted.
createHarvestJob_originEndpointId :: Lens.Lens' CreateHarvestJob Prelude.Text
createHarvestJob_originEndpointId :: Lens' CreateHarvestJob Text
createHarvestJob_originEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJob' {Text
originEndpointId :: Text
$sel:originEndpointId:CreateHarvestJob' :: CreateHarvestJob -> Text
originEndpointId} -> Text
originEndpointId) (\s :: CreateHarvestJob
s@CreateHarvestJob' {} Text
a -> CreateHarvestJob
s {$sel:originEndpointId:CreateHarvestJob' :: Text
originEndpointId = Text
a} :: CreateHarvestJob)

-- | The start of the time-window which will be harvested
createHarvestJob_startTime :: Lens.Lens' CreateHarvestJob Prelude.Text
createHarvestJob_startTime :: Lens' CreateHarvestJob Text
createHarvestJob_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJob' {Text
startTime :: Text
$sel:startTime:CreateHarvestJob' :: CreateHarvestJob -> Text
startTime} -> Text
startTime) (\s :: CreateHarvestJob
s@CreateHarvestJob' {} Text
a -> CreateHarvestJob
s {$sel:startTime:CreateHarvestJob' :: Text
startTime = Text
a} :: CreateHarvestJob)

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

instance Core.AWSRequest CreateHarvestJob where
  type
    AWSResponse CreateHarvestJob =
      CreateHarvestJobResponse
  request :: (Service -> Service)
-> CreateHarvestJob -> Request CreateHarvestJob
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 CreateHarvestJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateHarvestJob)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe S3Destination
-> Maybe Text
-> Maybe Status
-> Int
-> CreateHarvestJobResponse
CreateHarvestJobResponse'
            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
"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
"createdAt")
            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
"endTime")
            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
"originEndpointId")
            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
"s3Destination")
            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
"startTime")
            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
"status")
            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 CreateHarvestJob where
  hashWithSalt :: Int -> CreateHarvestJob -> Int
hashWithSalt Int
_salt CreateHarvestJob' {Text
S3Destination
id :: Text
startTime :: Text
originEndpointId :: Text
endTime :: Text
s3Destination :: S3Destination
$sel:id:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:startTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:originEndpointId:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:endTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:s3Destination:CreateHarvestJob' :: CreateHarvestJob -> S3Destination
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Destination
s3Destination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
originEndpointId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData CreateHarvestJob where
  rnf :: CreateHarvestJob -> ()
rnf CreateHarvestJob' {Text
S3Destination
id :: Text
startTime :: Text
originEndpointId :: Text
endTime :: Text
s3Destination :: S3Destination
$sel:id:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:startTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:originEndpointId:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:endTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:s3Destination:CreateHarvestJob' :: CreateHarvestJob -> S3Destination
..} =
    forall a. NFData a => a -> ()
Prelude.rnf S3Destination
s3Destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
originEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders CreateHarvestJob where
  toHeaders :: CreateHarvestJob -> 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 CreateHarvestJob where
  toJSON :: CreateHarvestJob -> Value
toJSON CreateHarvestJob' {Text
S3Destination
id :: Text
startTime :: Text
originEndpointId :: Text
endTime :: Text
s3Destination :: S3Destination
$sel:id:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:startTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:originEndpointId:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:endTime:CreateHarvestJob' :: CreateHarvestJob -> Text
$sel:s3Destination:CreateHarvestJob' :: CreateHarvestJob -> S3Destination
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"s3Destination" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Destination
s3Destination),
            forall a. a -> Maybe a
Prelude.Just (Key
"endTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endTime),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"originEndpointId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
originEndpointId),
            forall a. a -> Maybe a
Prelude.Just (Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
startTime),
            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 CreateHarvestJob where
  toPath :: CreateHarvestJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/harvest_jobs"

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

-- | /See:/ 'newCreateHarvestJobResponse' smart constructor.
data CreateHarvestJobResponse = CreateHarvestJobResponse'
  { -- | The Amazon Resource Name (ARN) assigned to the HarvestJob.
    CreateHarvestJobResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Channel that the HarvestJob will harvest from.
    CreateHarvestJobResponse -> Maybe Text
channelId :: Prelude.Maybe Prelude.Text,
    -- | The time the HarvestJob was submitted
    CreateHarvestJobResponse -> Maybe Text
createdAt :: Prelude.Maybe Prelude.Text,
    -- | The end of the time-window which will be harvested.
    CreateHarvestJobResponse -> Maybe Text
endTime :: Prelude.Maybe Prelude.Text,
    -- | The ID of the HarvestJob. The ID must be unique within the region and it
    -- cannot be changed after the HarvestJob is submitted.
    CreateHarvestJobResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The ID of the OriginEndpoint that the HarvestJob will harvest from. This
    -- cannot be changed after the HarvestJob is submitted.
    CreateHarvestJobResponse -> Maybe Text
originEndpointId :: Prelude.Maybe Prelude.Text,
    CreateHarvestJobResponse -> Maybe S3Destination
s3Destination :: Prelude.Maybe S3Destination,
    -- | The start of the time-window which will be harvested.
    CreateHarvestJobResponse -> Maybe Text
startTime :: Prelude.Maybe Prelude.Text,
    -- | The current status of the HarvestJob. Consider setting up a CloudWatch
    -- Event to listen for HarvestJobs as they succeed or fail. In the event of
    -- failure, the CloudWatch Event will include an explanation of why the
    -- HarvestJob failed.
    CreateHarvestJobResponse -> Maybe Status
status :: Prelude.Maybe Status,
    -- | The response's http status code.
    CreateHarvestJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateHarvestJobResponse -> CreateHarvestJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHarvestJobResponse -> CreateHarvestJobResponse -> Bool
$c/= :: CreateHarvestJobResponse -> CreateHarvestJobResponse -> Bool
== :: CreateHarvestJobResponse -> CreateHarvestJobResponse -> Bool
$c== :: CreateHarvestJobResponse -> CreateHarvestJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateHarvestJobResponse]
ReadPrec CreateHarvestJobResponse
Int -> ReadS CreateHarvestJobResponse
ReadS [CreateHarvestJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHarvestJobResponse]
$creadListPrec :: ReadPrec [CreateHarvestJobResponse]
readPrec :: ReadPrec CreateHarvestJobResponse
$creadPrec :: ReadPrec CreateHarvestJobResponse
readList :: ReadS [CreateHarvestJobResponse]
$creadList :: ReadS [CreateHarvestJobResponse]
readsPrec :: Int -> ReadS CreateHarvestJobResponse
$creadsPrec :: Int -> ReadS CreateHarvestJobResponse
Prelude.Read, Int -> CreateHarvestJobResponse -> ShowS
[CreateHarvestJobResponse] -> ShowS
CreateHarvestJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHarvestJobResponse] -> ShowS
$cshowList :: [CreateHarvestJobResponse] -> ShowS
show :: CreateHarvestJobResponse -> String
$cshow :: CreateHarvestJobResponse -> String
showsPrec :: Int -> CreateHarvestJobResponse -> ShowS
$cshowsPrec :: Int -> CreateHarvestJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateHarvestJobResponse x -> CreateHarvestJobResponse
forall x.
CreateHarvestJobResponse -> Rep CreateHarvestJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHarvestJobResponse x -> CreateHarvestJobResponse
$cfrom :: forall x.
CreateHarvestJobResponse -> Rep CreateHarvestJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateHarvestJobResponse' 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', 'createHarvestJobResponse_arn' - The Amazon Resource Name (ARN) assigned to the HarvestJob.
--
-- 'channelId', 'createHarvestJobResponse_channelId' - The ID of the Channel that the HarvestJob will harvest from.
--
-- 'createdAt', 'createHarvestJobResponse_createdAt' - The time the HarvestJob was submitted
--
-- 'endTime', 'createHarvestJobResponse_endTime' - The end of the time-window which will be harvested.
--
-- 'id', 'createHarvestJobResponse_id' - The ID of the HarvestJob. The ID must be unique within the region and it
-- cannot be changed after the HarvestJob is submitted.
--
-- 'originEndpointId', 'createHarvestJobResponse_originEndpointId' - The ID of the OriginEndpoint that the HarvestJob will harvest from. This
-- cannot be changed after the HarvestJob is submitted.
--
-- 's3Destination', 'createHarvestJobResponse_s3Destination' - Undocumented member.
--
-- 'startTime', 'createHarvestJobResponse_startTime' - The start of the time-window which will be harvested.
--
-- 'status', 'createHarvestJobResponse_status' - The current status of the HarvestJob. Consider setting up a CloudWatch
-- Event to listen for HarvestJobs as they succeed or fail. In the event of
-- failure, the CloudWatch Event will include an explanation of why the
-- HarvestJob failed.
--
-- 'httpStatus', 'createHarvestJobResponse_httpStatus' - The response's http status code.
newCreateHarvestJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateHarvestJobResponse
newCreateHarvestJobResponse :: Int -> CreateHarvestJobResponse
newCreateHarvestJobResponse Int
pHttpStatus_ =
  CreateHarvestJobResponse'
    { $sel:arn:CreateHarvestJobResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:channelId:CreateHarvestJobResponse' :: Maybe Text
channelId = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:CreateHarvestJobResponse' :: Maybe Text
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:CreateHarvestJobResponse' :: Maybe Text
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateHarvestJobResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:originEndpointId:CreateHarvestJobResponse' :: Maybe Text
originEndpointId = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Destination:CreateHarvestJobResponse' :: Maybe S3Destination
s3Destination = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:CreateHarvestJobResponse' :: Maybe Text
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateHarvestJobResponse' :: Maybe Status
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateHarvestJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The ID of the Channel that the HarvestJob will harvest from.
createHarvestJobResponse_channelId :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Prelude.Text)
createHarvestJobResponse_channelId :: Lens' CreateHarvestJobResponse (Maybe Text)
createHarvestJobResponse_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Text
channelId :: Maybe Text
$sel:channelId:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
channelId} -> Maybe Text
channelId) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Text
a -> CreateHarvestJobResponse
s {$sel:channelId:CreateHarvestJobResponse' :: Maybe Text
channelId = Maybe Text
a} :: CreateHarvestJobResponse)

-- | The time the HarvestJob was submitted
createHarvestJobResponse_createdAt :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Prelude.Text)
createHarvestJobResponse_createdAt :: Lens' CreateHarvestJobResponse (Maybe Text)
createHarvestJobResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Text
createdAt :: Maybe Text
$sel:createdAt:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
createdAt} -> Maybe Text
createdAt) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Text
a -> CreateHarvestJobResponse
s {$sel:createdAt:CreateHarvestJobResponse' :: Maybe Text
createdAt = Maybe Text
a} :: CreateHarvestJobResponse)

-- | The end of the time-window which will be harvested.
createHarvestJobResponse_endTime :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Prelude.Text)
createHarvestJobResponse_endTime :: Lens' CreateHarvestJobResponse (Maybe Text)
createHarvestJobResponse_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Text
endTime :: Maybe Text
$sel:endTime:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
endTime} -> Maybe Text
endTime) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Text
a -> CreateHarvestJobResponse
s {$sel:endTime:CreateHarvestJobResponse' :: Maybe Text
endTime = Maybe Text
a} :: CreateHarvestJobResponse)

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

-- | The ID of the OriginEndpoint that the HarvestJob will harvest from. This
-- cannot be changed after the HarvestJob is submitted.
createHarvestJobResponse_originEndpointId :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Prelude.Text)
createHarvestJobResponse_originEndpointId :: Lens' CreateHarvestJobResponse (Maybe Text)
createHarvestJobResponse_originEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Text
originEndpointId :: Maybe Text
$sel:originEndpointId:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
originEndpointId} -> Maybe Text
originEndpointId) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Text
a -> CreateHarvestJobResponse
s {$sel:originEndpointId:CreateHarvestJobResponse' :: Maybe Text
originEndpointId = Maybe Text
a} :: CreateHarvestJobResponse)

-- | Undocumented member.
createHarvestJobResponse_s3Destination :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe S3Destination)
createHarvestJobResponse_s3Destination :: Lens' CreateHarvestJobResponse (Maybe S3Destination)
createHarvestJobResponse_s3Destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe S3Destination
s3Destination :: Maybe S3Destination
$sel:s3Destination:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe S3Destination
s3Destination} -> Maybe S3Destination
s3Destination) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe S3Destination
a -> CreateHarvestJobResponse
s {$sel:s3Destination:CreateHarvestJobResponse' :: Maybe S3Destination
s3Destination = Maybe S3Destination
a} :: CreateHarvestJobResponse)

-- | The start of the time-window which will be harvested.
createHarvestJobResponse_startTime :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Prelude.Text)
createHarvestJobResponse_startTime :: Lens' CreateHarvestJobResponse (Maybe Text)
createHarvestJobResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Text
startTime :: Maybe Text
$sel:startTime:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
startTime} -> Maybe Text
startTime) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Text
a -> CreateHarvestJobResponse
s {$sel:startTime:CreateHarvestJobResponse' :: Maybe Text
startTime = Maybe Text
a} :: CreateHarvestJobResponse)

-- | The current status of the HarvestJob. Consider setting up a CloudWatch
-- Event to listen for HarvestJobs as they succeed or fail. In the event of
-- failure, the CloudWatch Event will include an explanation of why the
-- HarvestJob failed.
createHarvestJobResponse_status :: Lens.Lens' CreateHarvestJobResponse (Prelude.Maybe Status)
createHarvestJobResponse_status :: Lens' CreateHarvestJobResponse (Maybe Status)
createHarvestJobResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHarvestJobResponse' {Maybe Status
status :: Maybe Status
$sel:status:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Status
status} -> Maybe Status
status) (\s :: CreateHarvestJobResponse
s@CreateHarvestJobResponse' {} Maybe Status
a -> CreateHarvestJobResponse
s {$sel:status:CreateHarvestJobResponse' :: Maybe Status
status = Maybe Status
a} :: CreateHarvestJobResponse)

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

instance Prelude.NFData CreateHarvestJobResponse where
  rnf :: CreateHarvestJobResponse -> ()
rnf CreateHarvestJobResponse' {Int
Maybe Text
Maybe S3Destination
Maybe Status
httpStatus :: Int
status :: Maybe Status
startTime :: Maybe Text
s3Destination :: Maybe S3Destination
originEndpointId :: Maybe Text
id :: Maybe Text
endTime :: Maybe Text
createdAt :: Maybe Text
channelId :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Int
$sel:status:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Status
$sel:startTime:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:s3Destination:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe S3Destination
$sel:originEndpointId:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:id:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:endTime:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:createdAt:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:channelId:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> Maybe Text
$sel:arn:CreateHarvestJobResponse' :: CreateHarvestJobResponse -> 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 Text
channelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endTime
      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
originEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Destination
s3Destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Status
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus