{-# 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.IotTwinMaker.DeleteComponentType
-- 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 a component type.
module Amazonka.IotTwinMaker.DeleteComponentType
  ( -- * Creating a Request
    DeleteComponentType (..),
    newDeleteComponentType,

    -- * Request Lenses
    deleteComponentType_workspaceId,
    deleteComponentType_componentTypeId,

    -- * Destructuring the Response
    DeleteComponentTypeResponse (..),
    newDeleteComponentTypeResponse,

    -- * Response Lenses
    deleteComponentTypeResponse_httpStatus,
    deleteComponentTypeResponse_state,
  )
where

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

-- | /See:/ 'newDeleteComponentType' smart constructor.
data DeleteComponentType = DeleteComponentType'
  { -- | The ID of the workspace that contains the component type.
    DeleteComponentType -> Text
workspaceId :: Prelude.Text,
    -- | The ID of the component type to delete.
    DeleteComponentType -> Text
componentTypeId :: Prelude.Text
  }
  deriving (DeleteComponentType -> DeleteComponentType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteComponentType -> DeleteComponentType -> Bool
$c/= :: DeleteComponentType -> DeleteComponentType -> Bool
== :: DeleteComponentType -> DeleteComponentType -> Bool
$c== :: DeleteComponentType -> DeleteComponentType -> Bool
Prelude.Eq, ReadPrec [DeleteComponentType]
ReadPrec DeleteComponentType
Int -> ReadS DeleteComponentType
ReadS [DeleteComponentType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteComponentType]
$creadListPrec :: ReadPrec [DeleteComponentType]
readPrec :: ReadPrec DeleteComponentType
$creadPrec :: ReadPrec DeleteComponentType
readList :: ReadS [DeleteComponentType]
$creadList :: ReadS [DeleteComponentType]
readsPrec :: Int -> ReadS DeleteComponentType
$creadsPrec :: Int -> ReadS DeleteComponentType
Prelude.Read, Int -> DeleteComponentType -> ShowS
[DeleteComponentType] -> ShowS
DeleteComponentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteComponentType] -> ShowS
$cshowList :: [DeleteComponentType] -> ShowS
show :: DeleteComponentType -> String
$cshow :: DeleteComponentType -> String
showsPrec :: Int -> DeleteComponentType -> ShowS
$cshowsPrec :: Int -> DeleteComponentType -> ShowS
Prelude.Show, forall x. Rep DeleteComponentType x -> DeleteComponentType
forall x. DeleteComponentType -> Rep DeleteComponentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteComponentType x -> DeleteComponentType
$cfrom :: forall x. DeleteComponentType -> Rep DeleteComponentType x
Prelude.Generic)

-- |
-- Create a value of 'DeleteComponentType' 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:
--
-- 'workspaceId', 'deleteComponentType_workspaceId' - The ID of the workspace that contains the component type.
--
-- 'componentTypeId', 'deleteComponentType_componentTypeId' - The ID of the component type to delete.
newDeleteComponentType ::
  -- | 'workspaceId'
  Prelude.Text ->
  -- | 'componentTypeId'
  Prelude.Text ->
  DeleteComponentType
newDeleteComponentType :: Text -> Text -> DeleteComponentType
newDeleteComponentType
  Text
pWorkspaceId_
  Text
pComponentTypeId_ =
    DeleteComponentType'
      { $sel:workspaceId:DeleteComponentType' :: Text
workspaceId = Text
pWorkspaceId_,
        $sel:componentTypeId:DeleteComponentType' :: Text
componentTypeId = Text
pComponentTypeId_
      }

-- | The ID of the workspace that contains the component type.
deleteComponentType_workspaceId :: Lens.Lens' DeleteComponentType Prelude.Text
deleteComponentType_workspaceId :: Lens' DeleteComponentType Text
deleteComponentType_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComponentType' {Text
workspaceId :: Text
$sel:workspaceId:DeleteComponentType' :: DeleteComponentType -> Text
workspaceId} -> Text
workspaceId) (\s :: DeleteComponentType
s@DeleteComponentType' {} Text
a -> DeleteComponentType
s {$sel:workspaceId:DeleteComponentType' :: Text
workspaceId = Text
a} :: DeleteComponentType)

-- | The ID of the component type to delete.
deleteComponentType_componentTypeId :: Lens.Lens' DeleteComponentType Prelude.Text
deleteComponentType_componentTypeId :: Lens' DeleteComponentType Text
deleteComponentType_componentTypeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComponentType' {Text
componentTypeId :: Text
$sel:componentTypeId:DeleteComponentType' :: DeleteComponentType -> Text
componentTypeId} -> Text
componentTypeId) (\s :: DeleteComponentType
s@DeleteComponentType' {} Text
a -> DeleteComponentType
s {$sel:componentTypeId:DeleteComponentType' :: Text
componentTypeId = Text
a} :: DeleteComponentType)

instance Core.AWSRequest DeleteComponentType where
  type
    AWSResponse DeleteComponentType =
      DeleteComponentTypeResponse
  request :: (Service -> Service)
-> DeleteComponentType -> Request DeleteComponentType
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteComponentType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteComponentType)))
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 ->
          Int -> State -> DeleteComponentTypeResponse
DeleteComponentTypeResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"state")
      )

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

instance Prelude.NFData DeleteComponentType where
  rnf :: DeleteComponentType -> ()
rnf DeleteComponentType' {Text
componentTypeId :: Text
workspaceId :: Text
$sel:componentTypeId:DeleteComponentType' :: DeleteComponentType -> Text
$sel:workspaceId:DeleteComponentType' :: DeleteComponentType -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
componentTypeId

instance Data.ToHeaders DeleteComponentType where
  toHeaders :: DeleteComponentType -> 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.ToPath DeleteComponentType where
  toPath :: DeleteComponentType -> ByteString
toPath DeleteComponentType' {Text
componentTypeId :: Text
workspaceId :: Text
$sel:componentTypeId:DeleteComponentType' :: DeleteComponentType -> Text
$sel:workspaceId:DeleteComponentType' :: DeleteComponentType -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/component-types/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
componentTypeId
      ]

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

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

-- |
-- Create a value of 'DeleteComponentTypeResponse' 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', 'deleteComponentTypeResponse_httpStatus' - The response's http status code.
--
-- 'state', 'deleteComponentTypeResponse_state' - The current state of the component type to be deleted.
newDeleteComponentTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'state'
  State ->
  DeleteComponentTypeResponse
newDeleteComponentTypeResponse :: Int -> State -> DeleteComponentTypeResponse
newDeleteComponentTypeResponse Int
pHttpStatus_ State
pState_ =
  DeleteComponentTypeResponse'
    { $sel:httpStatus:DeleteComponentTypeResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:state:DeleteComponentTypeResponse' :: State
state = State
pState_
    }

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

-- | The current state of the component type to be deleted.
deleteComponentTypeResponse_state :: Lens.Lens' DeleteComponentTypeResponse State
deleteComponentTypeResponse_state :: Lens' DeleteComponentTypeResponse State
deleteComponentTypeResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComponentTypeResponse' {State
state :: State
$sel:state:DeleteComponentTypeResponse' :: DeleteComponentTypeResponse -> State
state} -> State
state) (\s :: DeleteComponentTypeResponse
s@DeleteComponentTypeResponse' {} State
a -> DeleteComponentTypeResponse
s {$sel:state:DeleteComponentTypeResponse' :: State
state = State
a} :: DeleteComponentTypeResponse)

instance Prelude.NFData DeleteComponentTypeResponse where
  rnf :: DeleteComponentTypeResponse -> ()
rnf DeleteComponentTypeResponse' {Int
State
state :: State
httpStatus :: Int
$sel:state:DeleteComponentTypeResponse' :: DeleteComponentTypeResponse -> State
$sel:httpStatus:DeleteComponentTypeResponse' :: DeleteComponentTypeResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf State
state