{-# 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.DataPipeline.SetStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Requests that the status of the specified physical or logical pipeline
-- objects be updated in the specified pipeline. This update might not
-- occur immediately, but is eventually consistent. The status that can be
-- set depends on the type of object (for example, DataNode or Activity).
-- You cannot perform this operation on @FINISHED@ pipelines and attempting
-- to do so returns @InvalidRequestException@.
module Amazonka.DataPipeline.SetStatus
  ( -- * Creating a Request
    SetStatus (..),
    newSetStatus,

    -- * Request Lenses
    setStatus_pipelineId,
    setStatus_objectIds,
    setStatus_status,

    -- * Destructuring the Response
    SetStatusResponse (..),
    newSetStatusResponse,
  )
where

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

-- | Contains the parameters for SetStatus.
--
-- /See:/ 'newSetStatus' smart constructor.
data SetStatus = SetStatus'
  { -- | The ID of the pipeline that contains the objects.
    SetStatus -> Text
pipelineId :: Prelude.Text,
    -- | The IDs of the objects. The corresponding objects can be either physical
    -- or components, but not a mix of both types.
    SetStatus -> [Text]
objectIds :: [Prelude.Text],
    -- | The status to be set on all the objects specified in @objectIds@. For
    -- components, use @PAUSE@ or @RESUME@. For instances, use @TRY_CANCEL@,
    -- @RERUN@, or @MARK_FINISHED@.
    SetStatus -> Text
status :: Prelude.Text
  }
  deriving (SetStatus -> SetStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetStatus -> SetStatus -> Bool
$c/= :: SetStatus -> SetStatus -> Bool
== :: SetStatus -> SetStatus -> Bool
$c== :: SetStatus -> SetStatus -> Bool
Prelude.Eq, ReadPrec [SetStatus]
ReadPrec SetStatus
Int -> ReadS SetStatus
ReadS [SetStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetStatus]
$creadListPrec :: ReadPrec [SetStatus]
readPrec :: ReadPrec SetStatus
$creadPrec :: ReadPrec SetStatus
readList :: ReadS [SetStatus]
$creadList :: ReadS [SetStatus]
readsPrec :: Int -> ReadS SetStatus
$creadsPrec :: Int -> ReadS SetStatus
Prelude.Read, Int -> SetStatus -> ShowS
[SetStatus] -> ShowS
SetStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetStatus] -> ShowS
$cshowList :: [SetStatus] -> ShowS
show :: SetStatus -> String
$cshow :: SetStatus -> String
showsPrec :: Int -> SetStatus -> ShowS
$cshowsPrec :: Int -> SetStatus -> ShowS
Prelude.Show, forall x. Rep SetStatus x -> SetStatus
forall x. SetStatus -> Rep SetStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetStatus x -> SetStatus
$cfrom :: forall x. SetStatus -> Rep SetStatus x
Prelude.Generic)

-- |
-- Create a value of 'SetStatus' 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:
--
-- 'pipelineId', 'setStatus_pipelineId' - The ID of the pipeline that contains the objects.
--
-- 'objectIds', 'setStatus_objectIds' - The IDs of the objects. The corresponding objects can be either physical
-- or components, but not a mix of both types.
--
-- 'status', 'setStatus_status' - The status to be set on all the objects specified in @objectIds@. For
-- components, use @PAUSE@ or @RESUME@. For instances, use @TRY_CANCEL@,
-- @RERUN@, or @MARK_FINISHED@.
newSetStatus ::
  -- | 'pipelineId'
  Prelude.Text ->
  -- | 'status'
  Prelude.Text ->
  SetStatus
newSetStatus :: Text -> Text -> SetStatus
newSetStatus Text
pPipelineId_ Text
pStatus_ =
  SetStatus'
    { $sel:pipelineId:SetStatus' :: Text
pipelineId = Text
pPipelineId_,
      $sel:objectIds:SetStatus' :: [Text]
objectIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:status:SetStatus' :: Text
status = Text
pStatus_
    }

-- | The ID of the pipeline that contains the objects.
setStatus_pipelineId :: Lens.Lens' SetStatus Prelude.Text
setStatus_pipelineId :: Lens' SetStatus Text
setStatus_pipelineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetStatus' {Text
pipelineId :: Text
$sel:pipelineId:SetStatus' :: SetStatus -> Text
pipelineId} -> Text
pipelineId) (\s :: SetStatus
s@SetStatus' {} Text
a -> SetStatus
s {$sel:pipelineId:SetStatus' :: Text
pipelineId = Text
a} :: SetStatus)

-- | The IDs of the objects. The corresponding objects can be either physical
-- or components, but not a mix of both types.
setStatus_objectIds :: Lens.Lens' SetStatus [Prelude.Text]
setStatus_objectIds :: Lens' SetStatus [Text]
setStatus_objectIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetStatus' {[Text]
objectIds :: [Text]
$sel:objectIds:SetStatus' :: SetStatus -> [Text]
objectIds} -> [Text]
objectIds) (\s :: SetStatus
s@SetStatus' {} [Text]
a -> SetStatus
s {$sel:objectIds:SetStatus' :: [Text]
objectIds = [Text]
a} :: SetStatus) 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

-- | The status to be set on all the objects specified in @objectIds@. For
-- components, use @PAUSE@ or @RESUME@. For instances, use @TRY_CANCEL@,
-- @RERUN@, or @MARK_FINISHED@.
setStatus_status :: Lens.Lens' SetStatus Prelude.Text
setStatus_status :: Lens' SetStatus Text
setStatus_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetStatus' {Text
status :: Text
$sel:status:SetStatus' :: SetStatus -> Text
status} -> Text
status) (\s :: SetStatus
s@SetStatus' {} Text
a -> SetStatus
s {$sel:status:SetStatus' :: Text
status = Text
a} :: SetStatus)

instance Core.AWSRequest SetStatus where
  type AWSResponse SetStatus = SetStatusResponse
  request :: (Service -> Service) -> SetStatus -> Request SetStatus
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 SetStatus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SetStatus)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SetStatusResponse
SetStatusResponse'

instance Prelude.Hashable SetStatus where
  hashWithSalt :: Int -> SetStatus -> Int
hashWithSalt Int
_salt SetStatus' {[Text]
Text
status :: Text
objectIds :: [Text]
pipelineId :: Text
$sel:status:SetStatus' :: SetStatus -> Text
$sel:objectIds:SetStatus' :: SetStatus -> [Text]
$sel:pipelineId:SetStatus' :: SetStatus -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
objectIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
status

instance Prelude.NFData SetStatus where
  rnf :: SetStatus -> ()
rnf SetStatus' {[Text]
Text
status :: Text
objectIds :: [Text]
pipelineId :: Text
$sel:status:SetStatus' :: SetStatus -> Text
$sel:objectIds:SetStatus' :: SetStatus -> [Text]
$sel:pipelineId:SetStatus' :: SetStatus -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
objectIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
status

instance Data.ToHeaders SetStatus where
  toHeaders :: SetStatus -> [Header]
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 -> [Header]
Data.=# (ByteString
"DataPipeline.SetStatus" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SetStatus where
  toJSON :: SetStatus -> Value
toJSON SetStatus' {[Text]
Text
status :: Text
objectIds :: [Text]
pipelineId :: Text
$sel:status:SetStatus' :: SetStatus -> Text
$sel:objectIds:SetStatus' :: SetStatus -> [Text]
$sel:pipelineId:SetStatus' :: SetStatus -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"pipelineId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pipelineId),
            forall a. a -> Maybe a
Prelude.Just (Key
"objectIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
objectIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
status)
          ]
      )

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

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

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

-- |
-- Create a value of 'SetStatusResponse' 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.
newSetStatusResponse ::
  SetStatusResponse
newSetStatusResponse :: SetStatusResponse
newSetStatusResponse = SetStatusResponse
SetStatusResponse'

instance Prelude.NFData SetStatusResponse where
  rnf :: SetStatusResponse -> ()
rnf SetStatusResponse
_ = ()