{-# 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.SageMaker.StopEdgePackagingJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Request to stop an edge packaging job.
module Amazonka.SageMaker.StopEdgePackagingJob
  ( -- * Creating a Request
    StopEdgePackagingJob (..),
    newStopEdgePackagingJob,

    -- * Request Lenses
    stopEdgePackagingJob_edgePackagingJobName,

    -- * Destructuring the Response
    StopEdgePackagingJobResponse (..),
    newStopEdgePackagingJobResponse,
  )
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.SageMaker.Types

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

-- |
-- Create a value of 'StopEdgePackagingJob' 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:
--
-- 'edgePackagingJobName', 'stopEdgePackagingJob_edgePackagingJobName' - The name of the edge packaging job.
newStopEdgePackagingJob ::
  -- | 'edgePackagingJobName'
  Prelude.Text ->
  StopEdgePackagingJob
newStopEdgePackagingJob :: Text -> StopEdgePackagingJob
newStopEdgePackagingJob Text
pEdgePackagingJobName_ =
  StopEdgePackagingJob'
    { $sel:edgePackagingJobName:StopEdgePackagingJob' :: Text
edgePackagingJobName =
        Text
pEdgePackagingJobName_
    }

-- | The name of the edge packaging job.
stopEdgePackagingJob_edgePackagingJobName :: Lens.Lens' StopEdgePackagingJob Prelude.Text
stopEdgePackagingJob_edgePackagingJobName :: Lens' StopEdgePackagingJob Text
stopEdgePackagingJob_edgePackagingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopEdgePackagingJob' {Text
edgePackagingJobName :: Text
$sel:edgePackagingJobName:StopEdgePackagingJob' :: StopEdgePackagingJob -> Text
edgePackagingJobName} -> Text
edgePackagingJobName) (\s :: StopEdgePackagingJob
s@StopEdgePackagingJob' {} Text
a -> StopEdgePackagingJob
s {$sel:edgePackagingJobName:StopEdgePackagingJob' :: Text
edgePackagingJobName = Text
a} :: StopEdgePackagingJob)

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

instance Prelude.Hashable StopEdgePackagingJob where
  hashWithSalt :: Int -> StopEdgePackagingJob -> Int
hashWithSalt Int
_salt StopEdgePackagingJob' {Text
edgePackagingJobName :: Text
$sel:edgePackagingJobName:StopEdgePackagingJob' :: StopEdgePackagingJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
edgePackagingJobName

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

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

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

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

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

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

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