{-# 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.IoT1ClickProjects.DisassociateDeviceFromPlacement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes a physical device from a placement.
module Amazonka.IoT1ClickProjects.DisassociateDeviceFromPlacement
  ( -- * Creating a Request
    DisassociateDeviceFromPlacement (..),
    newDisassociateDeviceFromPlacement,

    -- * Request Lenses
    disassociateDeviceFromPlacement_projectName,
    disassociateDeviceFromPlacement_placementName,
    disassociateDeviceFromPlacement_deviceTemplateName,

    -- * Destructuring the Response
    DisassociateDeviceFromPlacementResponse (..),
    newDisassociateDeviceFromPlacementResponse,

    -- * Response Lenses
    disassociateDeviceFromPlacementResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisassociateDeviceFromPlacement' smart constructor.
data DisassociateDeviceFromPlacement = DisassociateDeviceFromPlacement'
  { -- | The name of the project that contains the placement.
    DisassociateDeviceFromPlacement -> Text
projectName :: Prelude.Text,
    -- | The name of the placement that the device should be removed from.
    DisassociateDeviceFromPlacement -> Text
placementName :: Prelude.Text,
    -- | The device ID that should be removed from the placement.
    DisassociateDeviceFromPlacement -> Text
deviceTemplateName :: Prelude.Text
  }
  deriving (DisassociateDeviceFromPlacement
-> DisassociateDeviceFromPlacement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateDeviceFromPlacement
-> DisassociateDeviceFromPlacement -> Bool
$c/= :: DisassociateDeviceFromPlacement
-> DisassociateDeviceFromPlacement -> Bool
== :: DisassociateDeviceFromPlacement
-> DisassociateDeviceFromPlacement -> Bool
$c== :: DisassociateDeviceFromPlacement
-> DisassociateDeviceFromPlacement -> Bool
Prelude.Eq, ReadPrec [DisassociateDeviceFromPlacement]
ReadPrec DisassociateDeviceFromPlacement
Int -> ReadS DisassociateDeviceFromPlacement
ReadS [DisassociateDeviceFromPlacement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateDeviceFromPlacement]
$creadListPrec :: ReadPrec [DisassociateDeviceFromPlacement]
readPrec :: ReadPrec DisassociateDeviceFromPlacement
$creadPrec :: ReadPrec DisassociateDeviceFromPlacement
readList :: ReadS [DisassociateDeviceFromPlacement]
$creadList :: ReadS [DisassociateDeviceFromPlacement]
readsPrec :: Int -> ReadS DisassociateDeviceFromPlacement
$creadsPrec :: Int -> ReadS DisassociateDeviceFromPlacement
Prelude.Read, Int -> DisassociateDeviceFromPlacement -> ShowS
[DisassociateDeviceFromPlacement] -> ShowS
DisassociateDeviceFromPlacement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateDeviceFromPlacement] -> ShowS
$cshowList :: [DisassociateDeviceFromPlacement] -> ShowS
show :: DisassociateDeviceFromPlacement -> String
$cshow :: DisassociateDeviceFromPlacement -> String
showsPrec :: Int -> DisassociateDeviceFromPlacement -> ShowS
$cshowsPrec :: Int -> DisassociateDeviceFromPlacement -> ShowS
Prelude.Show, forall x.
Rep DisassociateDeviceFromPlacement x
-> DisassociateDeviceFromPlacement
forall x.
DisassociateDeviceFromPlacement
-> Rep DisassociateDeviceFromPlacement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateDeviceFromPlacement x
-> DisassociateDeviceFromPlacement
$cfrom :: forall x.
DisassociateDeviceFromPlacement
-> Rep DisassociateDeviceFromPlacement x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateDeviceFromPlacement' 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:
--
-- 'projectName', 'disassociateDeviceFromPlacement_projectName' - The name of the project that contains the placement.
--
-- 'placementName', 'disassociateDeviceFromPlacement_placementName' - The name of the placement that the device should be removed from.
--
-- 'deviceTemplateName', 'disassociateDeviceFromPlacement_deviceTemplateName' - The device ID that should be removed from the placement.
newDisassociateDeviceFromPlacement ::
  -- | 'projectName'
  Prelude.Text ->
  -- | 'placementName'
  Prelude.Text ->
  -- | 'deviceTemplateName'
  Prelude.Text ->
  DisassociateDeviceFromPlacement
newDisassociateDeviceFromPlacement :: Text -> Text -> Text -> DisassociateDeviceFromPlacement
newDisassociateDeviceFromPlacement
  Text
pProjectName_
  Text
pPlacementName_
  Text
pDeviceTemplateName_ =
    DisassociateDeviceFromPlacement'
      { $sel:projectName:DisassociateDeviceFromPlacement' :: Text
projectName =
          Text
pProjectName_,
        $sel:placementName:DisassociateDeviceFromPlacement' :: Text
placementName = Text
pPlacementName_,
        $sel:deviceTemplateName:DisassociateDeviceFromPlacement' :: Text
deviceTemplateName = Text
pDeviceTemplateName_
      }

-- | The name of the project that contains the placement.
disassociateDeviceFromPlacement_projectName :: Lens.Lens' DisassociateDeviceFromPlacement Prelude.Text
disassociateDeviceFromPlacement_projectName :: Lens' DisassociateDeviceFromPlacement Text
disassociateDeviceFromPlacement_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateDeviceFromPlacement' {Text
projectName :: Text
$sel:projectName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
projectName} -> Text
projectName) (\s :: DisassociateDeviceFromPlacement
s@DisassociateDeviceFromPlacement' {} Text
a -> DisassociateDeviceFromPlacement
s {$sel:projectName:DisassociateDeviceFromPlacement' :: Text
projectName = Text
a} :: DisassociateDeviceFromPlacement)

-- | The name of the placement that the device should be removed from.
disassociateDeviceFromPlacement_placementName :: Lens.Lens' DisassociateDeviceFromPlacement Prelude.Text
disassociateDeviceFromPlacement_placementName :: Lens' DisassociateDeviceFromPlacement Text
disassociateDeviceFromPlacement_placementName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateDeviceFromPlacement' {Text
placementName :: Text
$sel:placementName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
placementName} -> Text
placementName) (\s :: DisassociateDeviceFromPlacement
s@DisassociateDeviceFromPlacement' {} Text
a -> DisassociateDeviceFromPlacement
s {$sel:placementName:DisassociateDeviceFromPlacement' :: Text
placementName = Text
a} :: DisassociateDeviceFromPlacement)

-- | The device ID that should be removed from the placement.
disassociateDeviceFromPlacement_deviceTemplateName :: Lens.Lens' DisassociateDeviceFromPlacement Prelude.Text
disassociateDeviceFromPlacement_deviceTemplateName :: Lens' DisassociateDeviceFromPlacement Text
disassociateDeviceFromPlacement_deviceTemplateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateDeviceFromPlacement' {Text
deviceTemplateName :: Text
$sel:deviceTemplateName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
deviceTemplateName} -> Text
deviceTemplateName) (\s :: DisassociateDeviceFromPlacement
s@DisassociateDeviceFromPlacement' {} Text
a -> DisassociateDeviceFromPlacement
s {$sel:deviceTemplateName:DisassociateDeviceFromPlacement' :: Text
deviceTemplateName = Text
a} :: DisassociateDeviceFromPlacement)

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

instance
  Prelude.NFData
    DisassociateDeviceFromPlacement
  where
  rnf :: DisassociateDeviceFromPlacement -> ()
rnf DisassociateDeviceFromPlacement' {Text
deviceTemplateName :: Text
placementName :: Text
projectName :: Text
$sel:deviceTemplateName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
$sel:placementName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
$sel:projectName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
projectName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
placementName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceTemplateName

instance
  Data.ToHeaders
    DisassociateDeviceFromPlacement
  where
  toHeaders :: DisassociateDeviceFromPlacement -> 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 DisassociateDeviceFromPlacement where
  toPath :: DisassociateDeviceFromPlacement -> ByteString
toPath DisassociateDeviceFromPlacement' {Text
deviceTemplateName :: Text
placementName :: Text
projectName :: Text
$sel:deviceTemplateName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
$sel:placementName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
$sel:projectName:DisassociateDeviceFromPlacement' :: DisassociateDeviceFromPlacement -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
projectName,
        ByteString
"/placements/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
placementName,
        ByteString
"/devices/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceTemplateName
      ]

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

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

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

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

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