{-# 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.SnowDeviceManagement.CreateTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Instructs one or more devices to start a task, such as unlocking or
-- rebooting.
module Amazonka.SnowDeviceManagement.CreateTask
  ( -- * Creating a Request
    CreateTask (..),
    newCreateTask,

    -- * Request Lenses
    createTask_clientToken,
    createTask_description,
    createTask_tags,
    createTask_command,
    createTask_targets,

    -- * Destructuring the Response
    CreateTaskResponse (..),
    newCreateTaskResponse,

    -- * Response Lenses
    createTaskResponse_taskArn,
    createTaskResponse_taskId,
    createTaskResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateTask' smart constructor.
data CreateTask = CreateTask'
  { -- | A token ensuring that the action is called only once with the specified
    -- details.
    CreateTask -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the task and its targets.
    CreateTask -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata that you assign to a resource. You can use tags to
    -- categorize a resource in different ways, such as by purpose, owner, or
    -- environment.
    CreateTask -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The task to be performed. Only one task is executed on a device at a
    -- time.
    CreateTask -> Command
command :: Command,
    -- | A list of managed device IDs.
    CreateTask -> NonEmpty Text
targets :: Prelude.NonEmpty Prelude.Text
  }
  deriving (CreateTask -> CreateTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTask -> CreateTask -> Bool
$c/= :: CreateTask -> CreateTask -> Bool
== :: CreateTask -> CreateTask -> Bool
$c== :: CreateTask -> CreateTask -> Bool
Prelude.Eq, ReadPrec [CreateTask]
ReadPrec CreateTask
Int -> ReadS CreateTask
ReadS [CreateTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTask]
$creadListPrec :: ReadPrec [CreateTask]
readPrec :: ReadPrec CreateTask
$creadPrec :: ReadPrec CreateTask
readList :: ReadS [CreateTask]
$creadList :: ReadS [CreateTask]
readsPrec :: Int -> ReadS CreateTask
$creadsPrec :: Int -> ReadS CreateTask
Prelude.Read, Int -> CreateTask -> ShowS
[CreateTask] -> ShowS
CreateTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTask] -> ShowS
$cshowList :: [CreateTask] -> ShowS
show :: CreateTask -> String
$cshow :: CreateTask -> String
showsPrec :: Int -> CreateTask -> ShowS
$cshowsPrec :: Int -> CreateTask -> ShowS
Prelude.Show, forall x. Rep CreateTask x -> CreateTask
forall x. CreateTask -> Rep CreateTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTask x -> CreateTask
$cfrom :: forall x. CreateTask -> Rep CreateTask x
Prelude.Generic)

-- |
-- Create a value of 'CreateTask' 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:
--
-- 'clientToken', 'createTask_clientToken' - A token ensuring that the action is called only once with the specified
-- details.
--
-- 'description', 'createTask_description' - A description of the task and its targets.
--
-- 'tags', 'createTask_tags' - Optional metadata that you assign to a resource. You can use tags to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment.
--
-- 'command', 'createTask_command' - The task to be performed. Only one task is executed on a device at a
-- time.
--
-- 'targets', 'createTask_targets' - A list of managed device IDs.
newCreateTask ::
  -- | 'command'
  Command ->
  -- | 'targets'
  Prelude.NonEmpty Prelude.Text ->
  CreateTask
newCreateTask :: Command -> NonEmpty Text -> CreateTask
newCreateTask Command
pCommand_ NonEmpty Text
pTargets_ =
  CreateTask'
    { $sel:clientToken:CreateTask' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateTask' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateTask' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:command:CreateTask' :: Command
command = Command
pCommand_,
      $sel:targets:CreateTask' :: NonEmpty Text
targets = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pTargets_
    }

-- | A token ensuring that the action is called only once with the specified
-- details.
createTask_clientToken :: Lens.Lens' CreateTask (Prelude.Maybe Prelude.Text)
createTask_clientToken :: Lens' CreateTask (Maybe Text)
createTask_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateTask' :: CreateTask -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateTask
s@CreateTask' {} Maybe Text
a -> CreateTask
s {$sel:clientToken:CreateTask' :: Maybe Text
clientToken = Maybe Text
a} :: CreateTask)

-- | A description of the task and its targets.
createTask_description :: Lens.Lens' CreateTask (Prelude.Maybe Prelude.Text)
createTask_description :: Lens' CreateTask (Maybe Text)
createTask_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe Text
description :: Maybe Text
$sel:description:CreateTask' :: CreateTask -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateTask
s@CreateTask' {} Maybe Text
a -> CreateTask
s {$sel:description:CreateTask' :: Maybe Text
description = Maybe Text
a} :: CreateTask)

-- | Optional metadata that you assign to a resource. You can use tags to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment.
createTask_tags :: Lens.Lens' CreateTask (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createTask_tags :: Lens' CreateTask (Maybe (HashMap Text Text))
createTask_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateTask' :: CreateTask -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateTask
s@CreateTask' {} Maybe (HashMap Text Text)
a -> CreateTask
s {$sel:tags:CreateTask' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateTask) 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 task to be performed. Only one task is executed on a device at a
-- time.
createTask_command :: Lens.Lens' CreateTask Command
createTask_command :: Lens' CreateTask Command
createTask_command = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Command
command :: Command
$sel:command:CreateTask' :: CreateTask -> Command
command} -> Command
command) (\s :: CreateTask
s@CreateTask' {} Command
a -> CreateTask
s {$sel:command:CreateTask' :: Command
command = Command
a} :: CreateTask)

-- | A list of managed device IDs.
createTask_targets :: Lens.Lens' CreateTask (Prelude.NonEmpty Prelude.Text)
createTask_targets :: Lens' CreateTask (NonEmpty Text)
createTask_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {NonEmpty Text
targets :: NonEmpty Text
$sel:targets:CreateTask' :: CreateTask -> NonEmpty Text
targets} -> NonEmpty Text
targets) (\s :: CreateTask
s@CreateTask' {} NonEmpty Text
a -> CreateTask
s {$sel:targets:CreateTask' :: NonEmpty Text
targets = NonEmpty Text
a} :: CreateTask) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateTask where
  type AWSResponse CreateTask = CreateTaskResponse
  request :: (Service -> Service) -> CreateTask -> Request CreateTask
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 CreateTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTask)))
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 -> Int -> CreateTaskResponse
CreateTaskResponse'
            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
"taskArn")
            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
"taskId")
            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 CreateTask where
  hashWithSalt :: Int -> CreateTask -> Int
hashWithSalt Int
_salt CreateTask' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
Command
targets :: NonEmpty Text
command :: Command
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:targets:CreateTask' :: CreateTask -> NonEmpty Text
$sel:command:CreateTask' :: CreateTask -> Command
$sel:tags:CreateTask' :: CreateTask -> Maybe (HashMap Text Text)
$sel:description:CreateTask' :: CreateTask -> Maybe Text
$sel:clientToken:CreateTask' :: CreateTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Command
command
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
targets

instance Prelude.NFData CreateTask where
  rnf :: CreateTask -> ()
rnf CreateTask' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
Command
targets :: NonEmpty Text
command :: Command
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:targets:CreateTask' :: CreateTask -> NonEmpty Text
$sel:command:CreateTask' :: CreateTask -> Command
$sel:tags:CreateTask' :: CreateTask -> Maybe (HashMap Text Text)
$sel:description:CreateTask' :: CreateTask -> Maybe Text
$sel:clientToken:CreateTask' :: CreateTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Command
command
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
targets

instance Data.ToHeaders CreateTask where
  toHeaders :: CreateTask -> 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 CreateTask where
  toJSON :: CreateTask -> Value
toJSON CreateTask' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
Command
targets :: NonEmpty Text
command :: Command
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:targets:CreateTask' :: CreateTask -> NonEmpty Text
$sel:command:CreateTask' :: CreateTask -> Command
$sel:tags:CreateTask' :: CreateTask -> Maybe (HashMap Text Text)
$sel:description:CreateTask' :: CreateTask -> Maybe Text
$sel:clientToken:CreateTask' :: CreateTask -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"command" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Command
command),
            forall a. a -> Maybe a
Prelude.Just (Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
targets)
          ]
      )

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

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

-- | /See:/ 'newCreateTaskResponse' smart constructor.
data CreateTaskResponse = CreateTaskResponse'
  { -- | The Amazon Resource Name (ARN) of the task that you created.
    CreateTaskResponse -> Maybe Text
taskArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the task that you created.
    CreateTaskResponse -> Maybe Text
taskId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTaskResponse -> CreateTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTaskResponse -> CreateTaskResponse -> Bool
$c/= :: CreateTaskResponse -> CreateTaskResponse -> Bool
== :: CreateTaskResponse -> CreateTaskResponse -> Bool
$c== :: CreateTaskResponse -> CreateTaskResponse -> Bool
Prelude.Eq, ReadPrec [CreateTaskResponse]
ReadPrec CreateTaskResponse
Int -> ReadS CreateTaskResponse
ReadS [CreateTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTaskResponse]
$creadListPrec :: ReadPrec [CreateTaskResponse]
readPrec :: ReadPrec CreateTaskResponse
$creadPrec :: ReadPrec CreateTaskResponse
readList :: ReadS [CreateTaskResponse]
$creadList :: ReadS [CreateTaskResponse]
readsPrec :: Int -> ReadS CreateTaskResponse
$creadsPrec :: Int -> ReadS CreateTaskResponse
Prelude.Read, Int -> CreateTaskResponse -> ShowS
[CreateTaskResponse] -> ShowS
CreateTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTaskResponse] -> ShowS
$cshowList :: [CreateTaskResponse] -> ShowS
show :: CreateTaskResponse -> String
$cshow :: CreateTaskResponse -> String
showsPrec :: Int -> CreateTaskResponse -> ShowS
$cshowsPrec :: Int -> CreateTaskResponse -> ShowS
Prelude.Show, forall x. Rep CreateTaskResponse x -> CreateTaskResponse
forall x. CreateTaskResponse -> Rep CreateTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTaskResponse x -> CreateTaskResponse
$cfrom :: forall x. CreateTaskResponse -> Rep CreateTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTaskResponse' 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:
--
-- 'taskArn', 'createTaskResponse_taskArn' - The Amazon Resource Name (ARN) of the task that you created.
--
-- 'taskId', 'createTaskResponse_taskId' - The ID of the task that you created.
--
-- 'httpStatus', 'createTaskResponse_httpStatus' - The response's http status code.
newCreateTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTaskResponse
newCreateTaskResponse :: Int -> CreateTaskResponse
newCreateTaskResponse Int
pHttpStatus_ =
  CreateTaskResponse'
    { $sel:taskArn:CreateTaskResponse' :: Maybe Text
taskArn = forall a. Maybe a
Prelude.Nothing,
      $sel:taskId:CreateTaskResponse' :: Maybe Text
taskId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the task that you created.
createTaskResponse_taskArn :: Lens.Lens' CreateTaskResponse (Prelude.Maybe Prelude.Text)
createTaskResponse_taskArn :: Lens' CreateTaskResponse (Maybe Text)
createTaskResponse_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTaskResponse' {Maybe Text
taskArn :: Maybe Text
$sel:taskArn:CreateTaskResponse' :: CreateTaskResponse -> Maybe Text
taskArn} -> Maybe Text
taskArn) (\s :: CreateTaskResponse
s@CreateTaskResponse' {} Maybe Text
a -> CreateTaskResponse
s {$sel:taskArn:CreateTaskResponse' :: Maybe Text
taskArn = Maybe Text
a} :: CreateTaskResponse)

-- | The ID of the task that you created.
createTaskResponse_taskId :: Lens.Lens' CreateTaskResponse (Prelude.Maybe Prelude.Text)
createTaskResponse_taskId :: Lens' CreateTaskResponse (Maybe Text)
createTaskResponse_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTaskResponse' {Maybe Text
taskId :: Maybe Text
$sel:taskId:CreateTaskResponse' :: CreateTaskResponse -> Maybe Text
taskId} -> Maybe Text
taskId) (\s :: CreateTaskResponse
s@CreateTaskResponse' {} Maybe Text
a -> CreateTaskResponse
s {$sel:taskId:CreateTaskResponse' :: Maybe Text
taskId = Maybe Text
a} :: CreateTaskResponse)

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

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