{-# 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.DeleteFlowDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified flow definition.
module Amazonka.SageMaker.DeleteFlowDefinition
  ( -- * Creating a Request
    DeleteFlowDefinition (..),
    newDeleteFlowDefinition,

    -- * Request Lenses
    deleteFlowDefinition_flowDefinitionName,

    -- * Destructuring the Response
    DeleteFlowDefinitionResponse (..),
    newDeleteFlowDefinitionResponse,

    -- * Response Lenses
    deleteFlowDefinitionResponse_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.SageMaker.Types

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

-- |
-- Create a value of 'DeleteFlowDefinition' 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:
--
-- 'flowDefinitionName', 'deleteFlowDefinition_flowDefinitionName' - The name of the flow definition you are deleting.
newDeleteFlowDefinition ::
  -- | 'flowDefinitionName'
  Prelude.Text ->
  DeleteFlowDefinition
newDeleteFlowDefinition :: Text -> DeleteFlowDefinition
newDeleteFlowDefinition Text
pFlowDefinitionName_ =
  DeleteFlowDefinition'
    { $sel:flowDefinitionName:DeleteFlowDefinition' :: Text
flowDefinitionName =
        Text
pFlowDefinitionName_
    }

-- | The name of the flow definition you are deleting.
deleteFlowDefinition_flowDefinitionName :: Lens.Lens' DeleteFlowDefinition Prelude.Text
deleteFlowDefinition_flowDefinitionName :: Lens' DeleteFlowDefinition Text
deleteFlowDefinition_flowDefinitionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFlowDefinition' {Text
flowDefinitionName :: Text
$sel:flowDefinitionName:DeleteFlowDefinition' :: DeleteFlowDefinition -> Text
flowDefinitionName} -> Text
flowDefinitionName) (\s :: DeleteFlowDefinition
s@DeleteFlowDefinition' {} Text
a -> DeleteFlowDefinition
s {$sel:flowDefinitionName:DeleteFlowDefinition' :: Text
flowDefinitionName = Text
a} :: DeleteFlowDefinition)

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

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

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

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

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

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

-- |
-- Create a value of 'DeleteFlowDefinitionResponse' 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', 'deleteFlowDefinitionResponse_httpStatus' - The response's http status code.
newDeleteFlowDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteFlowDefinitionResponse
newDeleteFlowDefinitionResponse :: Int -> DeleteFlowDefinitionResponse
newDeleteFlowDefinitionResponse Int
pHttpStatus_ =
  DeleteFlowDefinitionResponse'
    { $sel:httpStatus:DeleteFlowDefinitionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

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