{-# 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.IoT.DetachThingPrincipal
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detaches the specified principal from the specified thing. A principal
-- can be X.509 certificates, IAM users, groups, and roles, Amazon Cognito
-- identities or federated identities.
--
-- This call is asynchronous. It might take several seconds for the
-- detachment to propagate.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DetachThingPrincipal>
-- action.
module Amazonka.IoT.DetachThingPrincipal
  ( -- * Creating a Request
    DetachThingPrincipal (..),
    newDetachThingPrincipal,

    -- * Request Lenses
    detachThingPrincipal_thingName,
    detachThingPrincipal_principal,

    -- * Destructuring the Response
    DetachThingPrincipalResponse (..),
    newDetachThingPrincipalResponse,

    -- * Response Lenses
    detachThingPrincipalResponse_httpStatus,
  )
where

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

-- | The input for the DetachThingPrincipal operation.
--
-- /See:/ 'newDetachThingPrincipal' smart constructor.
data DetachThingPrincipal = DetachThingPrincipal'
  { -- | The name of the thing.
    DetachThingPrincipal -> Text
thingName :: Prelude.Text,
    -- | If the principal is a certificate, this value must be ARN of the
    -- certificate. If the principal is an Amazon Cognito identity, this value
    -- must be the ID of the Amazon Cognito identity.
    DetachThingPrincipal -> Text
principal :: Prelude.Text
  }
  deriving (DetachThingPrincipal -> DetachThingPrincipal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetachThingPrincipal -> DetachThingPrincipal -> Bool
$c/= :: DetachThingPrincipal -> DetachThingPrincipal -> Bool
== :: DetachThingPrincipal -> DetachThingPrincipal -> Bool
$c== :: DetachThingPrincipal -> DetachThingPrincipal -> Bool
Prelude.Eq, ReadPrec [DetachThingPrincipal]
ReadPrec DetachThingPrincipal
Int -> ReadS DetachThingPrincipal
ReadS [DetachThingPrincipal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetachThingPrincipal]
$creadListPrec :: ReadPrec [DetachThingPrincipal]
readPrec :: ReadPrec DetachThingPrincipal
$creadPrec :: ReadPrec DetachThingPrincipal
readList :: ReadS [DetachThingPrincipal]
$creadList :: ReadS [DetachThingPrincipal]
readsPrec :: Int -> ReadS DetachThingPrincipal
$creadsPrec :: Int -> ReadS DetachThingPrincipal
Prelude.Read, Int -> DetachThingPrincipal -> ShowS
[DetachThingPrincipal] -> ShowS
DetachThingPrincipal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetachThingPrincipal] -> ShowS
$cshowList :: [DetachThingPrincipal] -> ShowS
show :: DetachThingPrincipal -> String
$cshow :: DetachThingPrincipal -> String
showsPrec :: Int -> DetachThingPrincipal -> ShowS
$cshowsPrec :: Int -> DetachThingPrincipal -> ShowS
Prelude.Show, forall x. Rep DetachThingPrincipal x -> DetachThingPrincipal
forall x. DetachThingPrincipal -> Rep DetachThingPrincipal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetachThingPrincipal x -> DetachThingPrincipal
$cfrom :: forall x. DetachThingPrincipal -> Rep DetachThingPrincipal x
Prelude.Generic)

-- |
-- Create a value of 'DetachThingPrincipal' 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:
--
-- 'thingName', 'detachThingPrincipal_thingName' - The name of the thing.
--
-- 'principal', 'detachThingPrincipal_principal' - If the principal is a certificate, this value must be ARN of the
-- certificate. If the principal is an Amazon Cognito identity, this value
-- must be the ID of the Amazon Cognito identity.
newDetachThingPrincipal ::
  -- | 'thingName'
  Prelude.Text ->
  -- | 'principal'
  Prelude.Text ->
  DetachThingPrincipal
newDetachThingPrincipal :: Text -> Text -> DetachThingPrincipal
newDetachThingPrincipal Text
pThingName_ Text
pPrincipal_ =
  DetachThingPrincipal'
    { $sel:thingName:DetachThingPrincipal' :: Text
thingName = Text
pThingName_,
      $sel:principal:DetachThingPrincipal' :: Text
principal = Text
pPrincipal_
    }

-- | The name of the thing.
detachThingPrincipal_thingName :: Lens.Lens' DetachThingPrincipal Prelude.Text
detachThingPrincipal_thingName :: Lens' DetachThingPrincipal Text
detachThingPrincipal_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachThingPrincipal' {Text
thingName :: Text
$sel:thingName:DetachThingPrincipal' :: DetachThingPrincipal -> Text
thingName} -> Text
thingName) (\s :: DetachThingPrincipal
s@DetachThingPrincipal' {} Text
a -> DetachThingPrincipal
s {$sel:thingName:DetachThingPrincipal' :: Text
thingName = Text
a} :: DetachThingPrincipal)

-- | If the principal is a certificate, this value must be ARN of the
-- certificate. If the principal is an Amazon Cognito identity, this value
-- must be the ID of the Amazon Cognito identity.
detachThingPrincipal_principal :: Lens.Lens' DetachThingPrincipal Prelude.Text
detachThingPrincipal_principal :: Lens' DetachThingPrincipal Text
detachThingPrincipal_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachThingPrincipal' {Text
principal :: Text
$sel:principal:DetachThingPrincipal' :: DetachThingPrincipal -> Text
principal} -> Text
principal) (\s :: DetachThingPrincipal
s@DetachThingPrincipal' {} Text
a -> DetachThingPrincipal
s {$sel:principal:DetachThingPrincipal' :: Text
principal = Text
a} :: DetachThingPrincipal)

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

instance Prelude.NFData DetachThingPrincipal where
  rnf :: DetachThingPrincipal -> ()
rnf DetachThingPrincipal' {Text
principal :: Text
thingName :: Text
$sel:principal:DetachThingPrincipal' :: DetachThingPrincipal -> Text
$sel:thingName:DetachThingPrincipal' :: DetachThingPrincipal -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
thingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
principal

instance Data.ToHeaders DetachThingPrincipal where
  toHeaders :: DetachThingPrincipal -> ResponseHeaders
toHeaders DetachThingPrincipal' {Text
principal :: Text
thingName :: Text
$sel:principal:DetachThingPrincipal' :: DetachThingPrincipal -> Text
$sel:thingName:DetachThingPrincipal' :: DetachThingPrincipal -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amzn-principal" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
principal]

instance Data.ToPath DetachThingPrincipal where
  toPath :: DetachThingPrincipal -> ByteString
toPath DetachThingPrincipal' {Text
principal :: Text
thingName :: Text
$sel:principal:DetachThingPrincipal' :: DetachThingPrincipal -> Text
$sel:thingName:DetachThingPrincipal' :: DetachThingPrincipal -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/things/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingName, ByteString
"/principals"]

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

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

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

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

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