{-# 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.DataSync.UpdateTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the metadata associated with a task.
module Amazonka.DataSync.UpdateTask
  ( -- * Creating a Request
    UpdateTask (..),
    newUpdateTask,

    -- * Request Lenses
    updateTask_cloudWatchLogGroupArn,
    updateTask_excludes,
    updateTask_includes,
    updateTask_name,
    updateTask_options,
    updateTask_schedule,
    updateTask_taskArn,

    -- * Destructuring the Response
    UpdateTaskResponse (..),
    newUpdateTaskResponse,

    -- * Response Lenses
    updateTaskResponse_httpStatus,
  )
where

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

-- | UpdateTaskResponse
--
-- /See:/ 'newUpdateTask' smart constructor.
data UpdateTask = UpdateTask'
  { -- | The Amazon Resource Name (ARN) of the resource name of the Amazon
    -- CloudWatch log group.
    UpdateTask -> Maybe Text
cloudWatchLogGroupArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies a list of filter rules that exclude specific data during your
    -- transfer. For more information and examples, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
    UpdateTask -> Maybe [FilterRule]
excludes :: Prelude.Maybe [FilterRule],
    -- | Specifies a list of filter rules that include specific data during your
    -- transfer. For more information and examples, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
    UpdateTask -> Maybe [FilterRule]
includes :: Prelude.Maybe [FilterRule],
    -- | The name of the task to update.
    UpdateTask -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    UpdateTask -> Maybe Options
options :: Prelude.Maybe Options,
    -- | Specifies a schedule used to periodically transfer files from a source
    -- to a destination location. You can configure your task to execute
    -- hourly, daily, weekly or on specific days of the week. You control when
    -- in the day or hour you want the task to execute. The time you specify is
    -- UTC time. For more information, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
    UpdateTask -> Maybe TaskSchedule
schedule :: Prelude.Maybe TaskSchedule,
    -- | The Amazon Resource Name (ARN) of the resource name of the task to
    -- update.
    UpdateTask -> Text
taskArn :: Prelude.Text
  }
  deriving (UpdateTask -> UpdateTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTask -> UpdateTask -> Bool
$c/= :: UpdateTask -> UpdateTask -> Bool
== :: UpdateTask -> UpdateTask -> Bool
$c== :: UpdateTask -> UpdateTask -> Bool
Prelude.Eq, ReadPrec [UpdateTask]
ReadPrec UpdateTask
Int -> ReadS UpdateTask
ReadS [UpdateTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTask]
$creadListPrec :: ReadPrec [UpdateTask]
readPrec :: ReadPrec UpdateTask
$creadPrec :: ReadPrec UpdateTask
readList :: ReadS [UpdateTask]
$creadList :: ReadS [UpdateTask]
readsPrec :: Int -> ReadS UpdateTask
$creadsPrec :: Int -> ReadS UpdateTask
Prelude.Read, Int -> UpdateTask -> ShowS
[UpdateTask] -> ShowS
UpdateTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTask] -> ShowS
$cshowList :: [UpdateTask] -> ShowS
show :: UpdateTask -> String
$cshow :: UpdateTask -> String
showsPrec :: Int -> UpdateTask -> ShowS
$cshowsPrec :: Int -> UpdateTask -> ShowS
Prelude.Show, forall x. Rep UpdateTask x -> UpdateTask
forall x. UpdateTask -> Rep UpdateTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTask x -> UpdateTask
$cfrom :: forall x. UpdateTask -> Rep UpdateTask x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTask' 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:
--
-- 'cloudWatchLogGroupArn', 'updateTask_cloudWatchLogGroupArn' - The Amazon Resource Name (ARN) of the resource name of the Amazon
-- CloudWatch log group.
--
-- 'excludes', 'updateTask_excludes' - Specifies a list of filter rules that exclude specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
--
-- 'includes', 'updateTask_includes' - Specifies a list of filter rules that include specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
--
-- 'name', 'updateTask_name' - The name of the task to update.
--
-- 'options', 'updateTask_options' - Undocumented member.
--
-- 'schedule', 'updateTask_schedule' - Specifies a schedule used to periodically transfer files from a source
-- to a destination location. You can configure your task to execute
-- hourly, daily, weekly or on specific days of the week. You control when
-- in the day or hour you want the task to execute. The time you specify is
-- UTC time. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
--
-- 'taskArn', 'updateTask_taskArn' - The Amazon Resource Name (ARN) of the resource name of the task to
-- update.
newUpdateTask ::
  -- | 'taskArn'
  Prelude.Text ->
  UpdateTask
newUpdateTask :: Text -> UpdateTask
newUpdateTask Text
pTaskArn_ =
  UpdateTask'
    { $sel:cloudWatchLogGroupArn:UpdateTask' :: Maybe Text
cloudWatchLogGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:excludes:UpdateTask' :: Maybe [FilterRule]
excludes = forall a. Maybe a
Prelude.Nothing,
      $sel:includes:UpdateTask' :: Maybe [FilterRule]
includes = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateTask' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:options:UpdateTask' :: Maybe Options
options = forall a. Maybe a
Prelude.Nothing,
      $sel:schedule:UpdateTask' :: Maybe TaskSchedule
schedule = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArn:UpdateTask' :: Text
taskArn = Text
pTaskArn_
    }

-- | The Amazon Resource Name (ARN) of the resource name of the Amazon
-- CloudWatch log group.
updateTask_cloudWatchLogGroupArn :: Lens.Lens' UpdateTask (Prelude.Maybe Prelude.Text)
updateTask_cloudWatchLogGroupArn :: Lens' UpdateTask (Maybe Text)
updateTask_cloudWatchLogGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe Text
cloudWatchLogGroupArn :: Maybe Text
$sel:cloudWatchLogGroupArn:UpdateTask' :: UpdateTask -> Maybe Text
cloudWatchLogGroupArn} -> Maybe Text
cloudWatchLogGroupArn) (\s :: UpdateTask
s@UpdateTask' {} Maybe Text
a -> UpdateTask
s {$sel:cloudWatchLogGroupArn:UpdateTask' :: Maybe Text
cloudWatchLogGroupArn = Maybe Text
a} :: UpdateTask)

-- | Specifies a list of filter rules that exclude specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
updateTask_excludes :: Lens.Lens' UpdateTask (Prelude.Maybe [FilterRule])
updateTask_excludes :: Lens' UpdateTask (Maybe [FilterRule])
updateTask_excludes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:excludes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
excludes} -> Maybe [FilterRule]
excludes) (\s :: UpdateTask
s@UpdateTask' {} Maybe [FilterRule]
a -> UpdateTask
s {$sel:excludes:UpdateTask' :: Maybe [FilterRule]
excludes = Maybe [FilterRule]
a} :: UpdateTask) 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

-- | Specifies a list of filter rules that include specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
updateTask_includes :: Lens.Lens' UpdateTask (Prelude.Maybe [FilterRule])
updateTask_includes :: Lens' UpdateTask (Maybe [FilterRule])
updateTask_includes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe [FilterRule]
includes :: Maybe [FilterRule]
$sel:includes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
includes} -> Maybe [FilterRule]
includes) (\s :: UpdateTask
s@UpdateTask' {} Maybe [FilterRule]
a -> UpdateTask
s {$sel:includes:UpdateTask' :: Maybe [FilterRule]
includes = Maybe [FilterRule]
a} :: UpdateTask) 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 name of the task to update.
updateTask_name :: Lens.Lens' UpdateTask (Prelude.Maybe Prelude.Text)
updateTask_name :: Lens' UpdateTask (Maybe Text)
updateTask_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe Text
name :: Maybe Text
$sel:name:UpdateTask' :: UpdateTask -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateTask
s@UpdateTask' {} Maybe Text
a -> UpdateTask
s {$sel:name:UpdateTask' :: Maybe Text
name = Maybe Text
a} :: UpdateTask)

-- | Undocumented member.
updateTask_options :: Lens.Lens' UpdateTask (Prelude.Maybe Options)
updateTask_options :: Lens' UpdateTask (Maybe Options)
updateTask_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe Options
options :: Maybe Options
$sel:options:UpdateTask' :: UpdateTask -> Maybe Options
options} -> Maybe Options
options) (\s :: UpdateTask
s@UpdateTask' {} Maybe Options
a -> UpdateTask
s {$sel:options:UpdateTask' :: Maybe Options
options = Maybe Options
a} :: UpdateTask)

-- | Specifies a schedule used to periodically transfer files from a source
-- to a destination location. You can configure your task to execute
-- hourly, daily, weekly or on specific days of the week. You control when
-- in the day or hour you want the task to execute. The time you specify is
-- UTC time. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
updateTask_schedule :: Lens.Lens' UpdateTask (Prelude.Maybe TaskSchedule)
updateTask_schedule :: Lens' UpdateTask (Maybe TaskSchedule)
updateTask_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Maybe TaskSchedule
schedule :: Maybe TaskSchedule
$sel:schedule:UpdateTask' :: UpdateTask -> Maybe TaskSchedule
schedule} -> Maybe TaskSchedule
schedule) (\s :: UpdateTask
s@UpdateTask' {} Maybe TaskSchedule
a -> UpdateTask
s {$sel:schedule:UpdateTask' :: Maybe TaskSchedule
schedule = Maybe TaskSchedule
a} :: UpdateTask)

-- | The Amazon Resource Name (ARN) of the resource name of the task to
-- update.
updateTask_taskArn :: Lens.Lens' UpdateTask Prelude.Text
updateTask_taskArn :: Lens' UpdateTask Text
updateTask_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTask' {Text
taskArn :: Text
$sel:taskArn:UpdateTask' :: UpdateTask -> Text
taskArn} -> Text
taskArn) (\s :: UpdateTask
s@UpdateTask' {} Text
a -> UpdateTask
s {$sel:taskArn:UpdateTask' :: Text
taskArn = Text
a} :: UpdateTask)

instance Core.AWSRequest UpdateTask where
  type AWSResponse UpdateTask = UpdateTaskResponse
  request :: (Service -> Service) -> UpdateTask -> Request UpdateTask
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 UpdateTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTask)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateTaskResponse
UpdateTaskResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateTask where
  hashWithSalt :: Int -> UpdateTask -> Int
hashWithSalt Int
_salt UpdateTask' {Maybe [FilterRule]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
taskArn :: Text
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:taskArn:UpdateTask' :: UpdateTask -> Text
$sel:schedule:UpdateTask' :: UpdateTask -> Maybe TaskSchedule
$sel:options:UpdateTask' :: UpdateTask -> Maybe Options
$sel:name:UpdateTask' :: UpdateTask -> Maybe Text
$sel:includes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:excludes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:UpdateTask' :: UpdateTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cloudWatchLogGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FilterRule]
excludes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FilterRule]
includes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Options
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskSchedule
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskArn

instance Prelude.NFData UpdateTask where
  rnf :: UpdateTask -> ()
rnf UpdateTask' {Maybe [FilterRule]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
taskArn :: Text
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:taskArn:UpdateTask' :: UpdateTask -> Text
$sel:schedule:UpdateTask' :: UpdateTask -> Maybe TaskSchedule
$sel:options:UpdateTask' :: UpdateTask -> Maybe Options
$sel:name:UpdateTask' :: UpdateTask -> Maybe Text
$sel:includes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:excludes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:UpdateTask' :: UpdateTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cloudWatchLogGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FilterRule]
excludes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FilterRule]
includes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Options
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskSchedule
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
taskArn

instance Data.ToHeaders UpdateTask where
  toHeaders :: UpdateTask -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"FmrsService.UpdateTask" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateTask where
  toJSON :: UpdateTask -> Value
toJSON UpdateTask' {Maybe [FilterRule]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
taskArn :: Text
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:taskArn:UpdateTask' :: UpdateTask -> Text
$sel:schedule:UpdateTask' :: UpdateTask -> Maybe TaskSchedule
$sel:options:UpdateTask' :: UpdateTask -> Maybe Options
$sel:name:UpdateTask' :: UpdateTask -> Maybe Text
$sel:includes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:excludes:UpdateTask' :: UpdateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:UpdateTask' :: UpdateTask -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CloudWatchLogGroupArn" 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
cloudWatchLogGroupArn,
            (Key
"Excludes" 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 [FilterRule]
excludes,
            (Key
"Includes" 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 [FilterRule]
includes,
            (Key
"Name" 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
name,
            (Key
"Options" 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 Options
options,
            (Key
"Schedule" 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 TaskSchedule
schedule,
            forall a. a -> Maybe a
Prelude.Just (Key
"TaskArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateTaskResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'updateTaskResponse_httpStatus' - The response's http status code.
newUpdateTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTaskResponse
newUpdateTaskResponse :: Int -> UpdateTaskResponse
newUpdateTaskResponse Int
pHttpStatus_ =
  UpdateTaskResponse' {$sel:httpStatus:UpdateTaskResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

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