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

    -- * Request Lenses
    attachSecurityProfile_securityProfileName,
    attachSecurityProfile_securityProfileTargetArn,

    -- * Destructuring the Response
    AttachSecurityProfileResponse (..),
    newAttachSecurityProfileResponse,

    -- * Response Lenses
    attachSecurityProfileResponse_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:/ 'newAttachSecurityProfile' smart constructor.
data AttachSecurityProfile = AttachSecurityProfile'
  { -- | The security profile that is attached.
    AttachSecurityProfile -> Text
securityProfileName :: Prelude.Text,
    -- | The ARN of the target (thing group) to which the security profile is
    -- attached.
    AttachSecurityProfile -> Text
securityProfileTargetArn :: Prelude.Text
  }
  deriving (AttachSecurityProfile -> AttachSecurityProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachSecurityProfile -> AttachSecurityProfile -> Bool
$c/= :: AttachSecurityProfile -> AttachSecurityProfile -> Bool
== :: AttachSecurityProfile -> AttachSecurityProfile -> Bool
$c== :: AttachSecurityProfile -> AttachSecurityProfile -> Bool
Prelude.Eq, ReadPrec [AttachSecurityProfile]
ReadPrec AttachSecurityProfile
Int -> ReadS AttachSecurityProfile
ReadS [AttachSecurityProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachSecurityProfile]
$creadListPrec :: ReadPrec [AttachSecurityProfile]
readPrec :: ReadPrec AttachSecurityProfile
$creadPrec :: ReadPrec AttachSecurityProfile
readList :: ReadS [AttachSecurityProfile]
$creadList :: ReadS [AttachSecurityProfile]
readsPrec :: Int -> ReadS AttachSecurityProfile
$creadsPrec :: Int -> ReadS AttachSecurityProfile
Prelude.Read, Int -> AttachSecurityProfile -> ShowS
[AttachSecurityProfile] -> ShowS
AttachSecurityProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachSecurityProfile] -> ShowS
$cshowList :: [AttachSecurityProfile] -> ShowS
show :: AttachSecurityProfile -> String
$cshow :: AttachSecurityProfile -> String
showsPrec :: Int -> AttachSecurityProfile -> ShowS
$cshowsPrec :: Int -> AttachSecurityProfile -> ShowS
Prelude.Show, forall x. Rep AttachSecurityProfile x -> AttachSecurityProfile
forall x. AttachSecurityProfile -> Rep AttachSecurityProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachSecurityProfile x -> AttachSecurityProfile
$cfrom :: forall x. AttachSecurityProfile -> Rep AttachSecurityProfile x
Prelude.Generic)

-- |
-- Create a value of 'AttachSecurityProfile' 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', 'attachSecurityProfile_securityProfileName' - The security profile that is attached.
--
-- 'securityProfileTargetArn', 'attachSecurityProfile_securityProfileTargetArn' - The ARN of the target (thing group) to which the security profile is
-- attached.
newAttachSecurityProfile ::
  -- | 'securityProfileName'
  Prelude.Text ->
  -- | 'securityProfileTargetArn'
  Prelude.Text ->
  AttachSecurityProfile
newAttachSecurityProfile :: Text -> Text -> AttachSecurityProfile
newAttachSecurityProfile
  Text
pSecurityProfileName_
  Text
pSecurityProfileTargetArn_ =
    AttachSecurityProfile'
      { $sel:securityProfileName:AttachSecurityProfile' :: Text
securityProfileName =
          Text
pSecurityProfileName_,
        $sel:securityProfileTargetArn:AttachSecurityProfile' :: Text
securityProfileTargetArn =
          Text
pSecurityProfileTargetArn_
      }

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

-- | The ARN of the target (thing group) to which the security profile is
-- attached.
attachSecurityProfile_securityProfileTargetArn :: Lens.Lens' AttachSecurityProfile Prelude.Text
attachSecurityProfile_securityProfileTargetArn :: Lens' AttachSecurityProfile Text
attachSecurityProfile_securityProfileTargetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachSecurityProfile' {Text
securityProfileTargetArn :: Text
$sel:securityProfileTargetArn:AttachSecurityProfile' :: AttachSecurityProfile -> Text
securityProfileTargetArn} -> Text
securityProfileTargetArn) (\s :: AttachSecurityProfile
s@AttachSecurityProfile' {} Text
a -> AttachSecurityProfile
s {$sel:securityProfileTargetArn:AttachSecurityProfile' :: Text
securityProfileTargetArn = Text
a} :: AttachSecurityProfile)

instance Core.AWSRequest AttachSecurityProfile where
  type
    AWSResponse AttachSecurityProfile =
      AttachSecurityProfileResponse
  request :: (Service -> Service)
-> AttachSecurityProfile -> Request AttachSecurityProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AttachSecurityProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AttachSecurityProfile)))
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 -> AttachSecurityProfileResponse
AttachSecurityProfileResponse'
            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 AttachSecurityProfile where
  hashWithSalt :: Int -> AttachSecurityProfile -> Int
hashWithSalt Int
_salt AttachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:AttachSecurityProfile' :: AttachSecurityProfile -> Text
$sel:securityProfileName:AttachSecurityProfile' :: AttachSecurityProfile -> 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 AttachSecurityProfile where
  rnf :: AttachSecurityProfile -> ()
rnf AttachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:AttachSecurityProfile' :: AttachSecurityProfile -> Text
$sel:securityProfileName:AttachSecurityProfile' :: AttachSecurityProfile -> 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 AttachSecurityProfile where
  toHeaders :: AttachSecurityProfile -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON AttachSecurityProfile where
  toJSON :: AttachSecurityProfile -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath AttachSecurityProfile where
  toPath :: AttachSecurityProfile -> ByteString
toPath AttachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:AttachSecurityProfile' :: AttachSecurityProfile -> Text
$sel:securityProfileName:AttachSecurityProfile' :: AttachSecurityProfile -> 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 AttachSecurityProfile where
  toQuery :: AttachSecurityProfile -> QueryString
toQuery AttachSecurityProfile' {Text
securityProfileTargetArn :: Text
securityProfileName :: Text
$sel:securityProfileTargetArn:AttachSecurityProfile' :: AttachSecurityProfile -> Text
$sel:securityProfileName:AttachSecurityProfile' :: AttachSecurityProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"securityProfileTargetArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
securityProfileTargetArn
      ]

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

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

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

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