{-# 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.FSx.CancelDataRepositoryTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels an existing Amazon FSx for Lustre data repository task if that
-- task is in either the @PENDING@ or @EXECUTING@ state. When you cancel a
-- task, Amazon FSx does the following.
--
-- -   Any files that FSx has already exported are not reverted.
--
-- -   FSx continues to export any files that are \"in-flight\" when the
--     cancel operation is received.
--
-- -   FSx does not export any files that have not yet been exported.
module Amazonka.FSx.CancelDataRepositoryTask
  ( -- * Creating a Request
    CancelDataRepositoryTask (..),
    newCancelDataRepositoryTask,

    -- * Request Lenses
    cancelDataRepositoryTask_taskId,

    -- * Destructuring the Response
    CancelDataRepositoryTaskResponse (..),
    newCancelDataRepositoryTaskResponse,

    -- * Response Lenses
    cancelDataRepositoryTaskResponse_lifecycle,
    cancelDataRepositoryTaskResponse_taskId,
    cancelDataRepositoryTaskResponse_httpStatus,
  )
where

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

-- | Cancels a data repository task.
--
-- /See:/ 'newCancelDataRepositoryTask' smart constructor.
data CancelDataRepositoryTask = CancelDataRepositoryTask'
  { -- | Specifies the data repository task to cancel.
    CancelDataRepositoryTask -> Text
taskId :: Prelude.Text
  }
  deriving (CancelDataRepositoryTask -> CancelDataRepositoryTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelDataRepositoryTask -> CancelDataRepositoryTask -> Bool
$c/= :: CancelDataRepositoryTask -> CancelDataRepositoryTask -> Bool
== :: CancelDataRepositoryTask -> CancelDataRepositoryTask -> Bool
$c== :: CancelDataRepositoryTask -> CancelDataRepositoryTask -> Bool
Prelude.Eq, ReadPrec [CancelDataRepositoryTask]
ReadPrec CancelDataRepositoryTask
Int -> ReadS CancelDataRepositoryTask
ReadS [CancelDataRepositoryTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelDataRepositoryTask]
$creadListPrec :: ReadPrec [CancelDataRepositoryTask]
readPrec :: ReadPrec CancelDataRepositoryTask
$creadPrec :: ReadPrec CancelDataRepositoryTask
readList :: ReadS [CancelDataRepositoryTask]
$creadList :: ReadS [CancelDataRepositoryTask]
readsPrec :: Int -> ReadS CancelDataRepositoryTask
$creadsPrec :: Int -> ReadS CancelDataRepositoryTask
Prelude.Read, Int -> CancelDataRepositoryTask -> ShowS
[CancelDataRepositoryTask] -> ShowS
CancelDataRepositoryTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelDataRepositoryTask] -> ShowS
$cshowList :: [CancelDataRepositoryTask] -> ShowS
show :: CancelDataRepositoryTask -> String
$cshow :: CancelDataRepositoryTask -> String
showsPrec :: Int -> CancelDataRepositoryTask -> ShowS
$cshowsPrec :: Int -> CancelDataRepositoryTask -> ShowS
Prelude.Show, forall x.
Rep CancelDataRepositoryTask x -> CancelDataRepositoryTask
forall x.
CancelDataRepositoryTask -> Rep CancelDataRepositoryTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelDataRepositoryTask x -> CancelDataRepositoryTask
$cfrom :: forall x.
CancelDataRepositoryTask -> Rep CancelDataRepositoryTask x
Prelude.Generic)

-- |
-- Create a value of 'CancelDataRepositoryTask' 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:
--
-- 'taskId', 'cancelDataRepositoryTask_taskId' - Specifies the data repository task to cancel.
newCancelDataRepositoryTask ::
  -- | 'taskId'
  Prelude.Text ->
  CancelDataRepositoryTask
newCancelDataRepositoryTask :: Text -> CancelDataRepositoryTask
newCancelDataRepositoryTask Text
pTaskId_ =
  CancelDataRepositoryTask' {$sel:taskId:CancelDataRepositoryTask' :: Text
taskId = Text
pTaskId_}

-- | Specifies the data repository task to cancel.
cancelDataRepositoryTask_taskId :: Lens.Lens' CancelDataRepositoryTask Prelude.Text
cancelDataRepositoryTask_taskId :: Lens' CancelDataRepositoryTask Text
cancelDataRepositoryTask_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelDataRepositoryTask' {Text
taskId :: Text
$sel:taskId:CancelDataRepositoryTask' :: CancelDataRepositoryTask -> Text
taskId} -> Text
taskId) (\s :: CancelDataRepositoryTask
s@CancelDataRepositoryTask' {} Text
a -> CancelDataRepositoryTask
s {$sel:taskId:CancelDataRepositoryTask' :: Text
taskId = Text
a} :: CancelDataRepositoryTask)

instance Core.AWSRequest CancelDataRepositoryTask where
  type
    AWSResponse CancelDataRepositoryTask =
      CancelDataRepositoryTaskResponse
  request :: (Service -> Service)
-> CancelDataRepositoryTask -> Request CancelDataRepositoryTask
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 CancelDataRepositoryTask
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CancelDataRepositoryTask)))
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 DataRepositoryTaskLifecycle
-> Maybe Text -> Int -> CancelDataRepositoryTaskResponse
CancelDataRepositoryTaskResponse'
            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
"Lifecycle")
            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 CancelDataRepositoryTask where
  hashWithSalt :: Int -> CancelDataRepositoryTask -> Int
hashWithSalt Int
_salt CancelDataRepositoryTask' {Text
taskId :: Text
$sel:taskId:CancelDataRepositoryTask' :: CancelDataRepositoryTask -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskId

instance Prelude.NFData CancelDataRepositoryTask where
  rnf :: CancelDataRepositoryTask -> ()
rnf CancelDataRepositoryTask' {Text
taskId :: Text
$sel:taskId:CancelDataRepositoryTask' :: CancelDataRepositoryTask -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
taskId

instance Data.ToHeaders CancelDataRepositoryTask where
  toHeaders :: CancelDataRepositoryTask -> 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
"AWSSimbaAPIService_v20180301.CancelDataRepositoryTask" ::
                          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 CancelDataRepositoryTask where
  toJSON :: CancelDataRepositoryTask -> Value
toJSON CancelDataRepositoryTask' {Text
taskId :: Text
$sel:taskId:CancelDataRepositoryTask' :: CancelDataRepositoryTask -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"TaskId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskId)]
      )

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

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

-- | /See:/ 'newCancelDataRepositoryTaskResponse' smart constructor.
data CancelDataRepositoryTaskResponse = CancelDataRepositoryTaskResponse'
  { -- | The lifecycle status of the data repository task, as follows:
    --
    -- -   @PENDING@ - Amazon FSx has not started the task.
    --
    -- -   @EXECUTING@ - Amazon FSx is processing the task.
    --
    -- -   @FAILED@ - Amazon FSx was not able to complete the task. For
    --     example, there may be files the task failed to process. The
    --     DataRepositoryTaskFailureDetails property provides more information
    --     about task failures.
    --
    -- -   @SUCCEEDED@ - FSx completed the task successfully.
    --
    -- -   @CANCELED@ - Amazon FSx canceled the task and it did not complete.
    --
    -- -   @CANCELING@ - FSx is in process of canceling the task.
    CancelDataRepositoryTaskResponse
-> Maybe DataRepositoryTaskLifecycle
lifecycle :: Prelude.Maybe DataRepositoryTaskLifecycle,
    -- | The ID of the task being canceled.
    CancelDataRepositoryTaskResponse -> Maybe Text
taskId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CancelDataRepositoryTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelDataRepositoryTaskResponse
-> CancelDataRepositoryTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelDataRepositoryTaskResponse
-> CancelDataRepositoryTaskResponse -> Bool
$c/= :: CancelDataRepositoryTaskResponse
-> CancelDataRepositoryTaskResponse -> Bool
== :: CancelDataRepositoryTaskResponse
-> CancelDataRepositoryTaskResponse -> Bool
$c== :: CancelDataRepositoryTaskResponse
-> CancelDataRepositoryTaskResponse -> Bool
Prelude.Eq, ReadPrec [CancelDataRepositoryTaskResponse]
ReadPrec CancelDataRepositoryTaskResponse
Int -> ReadS CancelDataRepositoryTaskResponse
ReadS [CancelDataRepositoryTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelDataRepositoryTaskResponse]
$creadListPrec :: ReadPrec [CancelDataRepositoryTaskResponse]
readPrec :: ReadPrec CancelDataRepositoryTaskResponse
$creadPrec :: ReadPrec CancelDataRepositoryTaskResponse
readList :: ReadS [CancelDataRepositoryTaskResponse]
$creadList :: ReadS [CancelDataRepositoryTaskResponse]
readsPrec :: Int -> ReadS CancelDataRepositoryTaskResponse
$creadsPrec :: Int -> ReadS CancelDataRepositoryTaskResponse
Prelude.Read, Int -> CancelDataRepositoryTaskResponse -> ShowS
[CancelDataRepositoryTaskResponse] -> ShowS
CancelDataRepositoryTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelDataRepositoryTaskResponse] -> ShowS
$cshowList :: [CancelDataRepositoryTaskResponse] -> ShowS
show :: CancelDataRepositoryTaskResponse -> String
$cshow :: CancelDataRepositoryTaskResponse -> String
showsPrec :: Int -> CancelDataRepositoryTaskResponse -> ShowS
$cshowsPrec :: Int -> CancelDataRepositoryTaskResponse -> ShowS
Prelude.Show, forall x.
Rep CancelDataRepositoryTaskResponse x
-> CancelDataRepositoryTaskResponse
forall x.
CancelDataRepositoryTaskResponse
-> Rep CancelDataRepositoryTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelDataRepositoryTaskResponse x
-> CancelDataRepositoryTaskResponse
$cfrom :: forall x.
CancelDataRepositoryTaskResponse
-> Rep CancelDataRepositoryTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelDataRepositoryTaskResponse' 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:
--
-- 'lifecycle', 'cancelDataRepositoryTaskResponse_lifecycle' - The lifecycle status of the data repository task, as follows:
--
-- -   @PENDING@ - Amazon FSx has not started the task.
--
-- -   @EXECUTING@ - Amazon FSx is processing the task.
--
-- -   @FAILED@ - Amazon FSx was not able to complete the task. For
--     example, there may be files the task failed to process. The
--     DataRepositoryTaskFailureDetails property provides more information
--     about task failures.
--
-- -   @SUCCEEDED@ - FSx completed the task successfully.
--
-- -   @CANCELED@ - Amazon FSx canceled the task and it did not complete.
--
-- -   @CANCELING@ - FSx is in process of canceling the task.
--
-- 'taskId', 'cancelDataRepositoryTaskResponse_taskId' - The ID of the task being canceled.
--
-- 'httpStatus', 'cancelDataRepositoryTaskResponse_httpStatus' - The response's http status code.
newCancelDataRepositoryTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelDataRepositoryTaskResponse
newCancelDataRepositoryTaskResponse :: Int -> CancelDataRepositoryTaskResponse
newCancelDataRepositoryTaskResponse Int
pHttpStatus_ =
  CancelDataRepositoryTaskResponse'
    { $sel:lifecycle:CancelDataRepositoryTaskResponse' :: Maybe DataRepositoryTaskLifecycle
lifecycle =
        forall a. Maybe a
Prelude.Nothing,
      $sel:taskId:CancelDataRepositoryTaskResponse' :: Maybe Text
taskId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelDataRepositoryTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The lifecycle status of the data repository task, as follows:
--
-- -   @PENDING@ - Amazon FSx has not started the task.
--
-- -   @EXECUTING@ - Amazon FSx is processing the task.
--
-- -   @FAILED@ - Amazon FSx was not able to complete the task. For
--     example, there may be files the task failed to process. The
--     DataRepositoryTaskFailureDetails property provides more information
--     about task failures.
--
-- -   @SUCCEEDED@ - FSx completed the task successfully.
--
-- -   @CANCELED@ - Amazon FSx canceled the task and it did not complete.
--
-- -   @CANCELING@ - FSx is in process of canceling the task.
cancelDataRepositoryTaskResponse_lifecycle :: Lens.Lens' CancelDataRepositoryTaskResponse (Prelude.Maybe DataRepositoryTaskLifecycle)
cancelDataRepositoryTaskResponse_lifecycle :: Lens'
  CancelDataRepositoryTaskResponse
  (Maybe DataRepositoryTaskLifecycle)
cancelDataRepositoryTaskResponse_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelDataRepositoryTaskResponse' {Maybe DataRepositoryTaskLifecycle
lifecycle :: Maybe DataRepositoryTaskLifecycle
$sel:lifecycle:CancelDataRepositoryTaskResponse' :: CancelDataRepositoryTaskResponse
-> Maybe DataRepositoryTaskLifecycle
lifecycle} -> Maybe DataRepositoryTaskLifecycle
lifecycle) (\s :: CancelDataRepositoryTaskResponse
s@CancelDataRepositoryTaskResponse' {} Maybe DataRepositoryTaskLifecycle
a -> CancelDataRepositoryTaskResponse
s {$sel:lifecycle:CancelDataRepositoryTaskResponse' :: Maybe DataRepositoryTaskLifecycle
lifecycle = Maybe DataRepositoryTaskLifecycle
a} :: CancelDataRepositoryTaskResponse)

-- | The ID of the task being canceled.
cancelDataRepositoryTaskResponse_taskId :: Lens.Lens' CancelDataRepositoryTaskResponse (Prelude.Maybe Prelude.Text)
cancelDataRepositoryTaskResponse_taskId :: Lens' CancelDataRepositoryTaskResponse (Maybe Text)
cancelDataRepositoryTaskResponse_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelDataRepositoryTaskResponse' {Maybe Text
taskId :: Maybe Text
$sel:taskId:CancelDataRepositoryTaskResponse' :: CancelDataRepositoryTaskResponse -> Maybe Text
taskId} -> Maybe Text
taskId) (\s :: CancelDataRepositoryTaskResponse
s@CancelDataRepositoryTaskResponse' {} Maybe Text
a -> CancelDataRepositoryTaskResponse
s {$sel:taskId:CancelDataRepositoryTaskResponse' :: Maybe Text
taskId = Maybe Text
a} :: CancelDataRepositoryTaskResponse)

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

instance
  Prelude.NFData
    CancelDataRepositoryTaskResponse
  where
  rnf :: CancelDataRepositoryTaskResponse -> ()
rnf CancelDataRepositoryTaskResponse' {Int
Maybe Text
Maybe DataRepositoryTaskLifecycle
httpStatus :: Int
taskId :: Maybe Text
lifecycle :: Maybe DataRepositoryTaskLifecycle
$sel:httpStatus:CancelDataRepositoryTaskResponse' :: CancelDataRepositoryTaskResponse -> Int
$sel:taskId:CancelDataRepositoryTaskResponse' :: CancelDataRepositoryTaskResponse -> Maybe Text
$sel:lifecycle:CancelDataRepositoryTaskResponse' :: CancelDataRepositoryTaskResponse
-> Maybe DataRepositoryTaskLifecycle
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataRepositoryTaskLifecycle
lifecycle
      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