{-# 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.DetachSecurityProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates a Device Defender security profile from a thing group or
-- from this account.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DetachSecurityProfile>
-- action.
module Amazonka.IoT.DetachSecurityProfile
  ( -- * Creating a Request
    DetachSecurityProfile (..),
    newDetachSecurityProfile,

    -- * Request Lenses
    detachSecurityProfile_securityProfileName,
    detachSecurityProfile_securityProfileTargetArn,

    -- * Destructuring the Response
    DetachSecurityProfileResponse (..),
    newDetachSecurityProfileResponse,

    -- * Response Lenses
    detachSecurityProfileResponse_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

-- | /See:/ 'newDetachSecurityProfile' smart constructor.
data DetachSecurityProfile = DetachSecurityProfile'
  { -- | The security profile that is detached.
    DetachSecurityProfile -> Text
securityProfileName :: Prelude.Text,
    -- | The ARN of the thing group from which the security profile is detached.
    DetachSecurityProfile -> Text
securityProfileTargetArn :: Prelude.Text
  }
  deriving (DetachSecurityProfile -> DetachSecurityProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetachSecurityProfile -> DetachSecurityProfile -> Bool
$c/= :: DetachSecurityProfile -> DetachSecurityProfile -> Bool
== :: DetachSecurityProfile -> DetachSecurityProfile -> Bool
$c== :: DetachSecurityProfile -> DetachSecurityProfile -> Bool
Prelude.Eq, ReadPrec [DetachSecurityProfile]
ReadPrec DetachSecurityProfile
Int -> ReadS DetachSecurityProfile
ReadS [DetachSecurityProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetachSecurityProfile]
$creadListPrec :: ReadPrec [DetachSecurityProfile]
readPrec :: ReadPrec DetachSecurityProfile
$creadPrec :: ReadPrec DetachSecurityProfile
readList :: ReadS [DetachSecurityProfile]
$creadList :: ReadS [DetachSecurityProfile]
readsPrec :: Int -> ReadS DetachSecurityProfile
$creadsPrec :: Int -> ReadS DetachSecurityProfile
Prelude.Read, Int -> DetachSecurityProfile -> ShowS
[DetachSecurityProfile] -> ShowS
DetachSecurityProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetachSecurityProfile] -> ShowS
$cshowList :: [DetachSecurityProfile] -> ShowS
show :: DetachSecurityProfile -> String
$cshow :: DetachSecurityProfile -> String
showsPrec :: Int -> DetachSecurityProfile -> ShowS
$cshowsPrec :: Int -> DetachSecurityProfile -> ShowS
Prelude.Show, forall x. Rep DetachSecurityProfile x -> DetachSecurityProfile
forall x. DetachSecurityProfile -> Rep DetachSecurityProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetachSecurityProfile x -> DetachSecurityProfile
$cfrom :: forall x. DetachSecurityProfile -> Rep DetachSecurityProfile x
Prelude.Generic)

-- |
-- Create a value of 'DetachSecurityProfile' 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:
--
-- 'securityProfileName', 'detachSecurityProfile_securityProfileName' - The security profile that is detached.
--
-- 'securityProfileTargetArn', 'detachSecurityProfile_securityProfileTargetArn' - The ARN of the thing group from which the security profile is detached.
newDetachSecurityProfile ::
  -- | 'securityProfileName'
  Prelude.Text ->
  -- | 'securityProfileTargetArn'
  Prelude.Text ->
  DetachSecurityProfile
newDetachSecurityProfile :: Text -> Text -> DetachSecurityProfile
newDetachSecurityProfile
  Text
pSecurityProfileName_
  Text
pSecurityProfileTargetArn_ =
    DetachSecurityProfile'
      { $sel:securityProfileName:DetachSecurityProfile' :: Text
securityProfileName =
          Text
pSecurityProfileName_,
        $sel:securityProfileTargetArn:DetachSecurityProfile' :: Text
securityProfileTargetArn =
          Text
pSecurityProfileTargetArn_
      }

-- | The security profile that is detached.
detachSecurityProfile_securityProfileName :: Lens.Lens' DetachSecurityProfile Prelude.Text
detachSecurityProfile_securityProfileName :: Lens' DetachSecurityProfile Text
detachSecurityProfile_securityProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachSecurityProfile' {Text
securityProfileName :: Text
$sel:securityProfileName:DetachSecurityProfile' :: DetachSecurityProfile -> Text
securityProfileName} -> Text
securityProfileName) (\s :: DetachSecurityProfile
s@DetachSecurityProfile' {} Text
a -> DetachSecurityProfile
s {$sel:securityProfileName:DetachSecurityProfile' :: Text
securityProfileName = Text
a} :: DetachSecurityProfile)

-- | The ARN of the thing group from which the security profile is detached.
detachSecurityProfile_securityProfileTargetArn :: Lens.Lens' DetachSecurityProfile Prelude.Text
detachSecurityProfile_securityProfileTargetArn :: Lens' DetachSecurityProfile Text
detachSecurityProfile_securityProfileTargetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachSecurityProfile' {Text
securityProfileTargetArn :: Text
$sel:securityProfileTargetArn:DetachSecurityProfile' :: DetachSecurityProfile -> Text
securityProfileTargetArn} -> Text
securityProfileTargetArn) (\s :: DetachSecurityProfile
s@DetachSecurityProfile' {} Text
a -> DetachSecurityProfile
s {$sel:securityProfileTargetArn:DetachSecurityProfile' :: Text
securityProfileTargetArn = Text
a} :: DetachSecurityProfile)

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

instance Prelude.NFData DetachSecurityProfile where
  rnf :: DetachSecurityProfile -> ()
rnf DetachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:DetachSecurityProfile' :: DetachSecurityProfile -> Text
$sel:securityProfileName:DetachSecurityProfile' :: DetachSecurityProfile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
securityProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
securityProfileTargetArn

instance Data.ToHeaders DetachSecurityProfile where
  toHeaders :: DetachSecurityProfile -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DetachSecurityProfile where
  toPath :: DetachSecurityProfile -> ByteString
toPath DetachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:DetachSecurityProfile' :: DetachSecurityProfile -> Text
$sel:securityProfileName:DetachSecurityProfile' :: DetachSecurityProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/security-profiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
securityProfileName,
        ByteString
"/targets"
      ]

instance Data.ToQuery DetachSecurityProfile where
  toQuery :: DetachSecurityProfile -> QueryString
toQuery DetachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:DetachSecurityProfile' :: DetachSecurityProfile -> Text
$sel:securityProfileName:DetachSecurityProfile' :: DetachSecurityProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"securityProfileTargetArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
securityProfileTargetArn
      ]

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

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

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

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