{-# 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.EC2.DisassociateIamInstanceProfile
-- 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 an IAM instance profile from a running or stopped
-- instance.
--
-- Use DescribeIamInstanceProfileAssociations to get the association ID.
module Amazonka.EC2.DisassociateIamInstanceProfile
  ( -- * Creating a Request
    DisassociateIamInstanceProfile (..),
    newDisassociateIamInstanceProfile,

    -- * Request Lenses
    disassociateIamInstanceProfile_associationId,

    -- * Destructuring the Response
    DisassociateIamInstanceProfileResponse (..),
    newDisassociateIamInstanceProfileResponse,

    -- * Response Lenses
    disassociateIamInstanceProfileResponse_iamInstanceProfileAssociation,
    disassociateIamInstanceProfileResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisassociateIamInstanceProfile' smart constructor.
data DisassociateIamInstanceProfile = DisassociateIamInstanceProfile'
  { -- | The ID of the IAM instance profile association.
    DisassociateIamInstanceProfile -> Text
associationId :: Prelude.Text
  }
  deriving (DisassociateIamInstanceProfile
-> DisassociateIamInstanceProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateIamInstanceProfile
-> DisassociateIamInstanceProfile -> Bool
$c/= :: DisassociateIamInstanceProfile
-> DisassociateIamInstanceProfile -> Bool
== :: DisassociateIamInstanceProfile
-> DisassociateIamInstanceProfile -> Bool
$c== :: DisassociateIamInstanceProfile
-> DisassociateIamInstanceProfile -> Bool
Prelude.Eq, ReadPrec [DisassociateIamInstanceProfile]
ReadPrec DisassociateIamInstanceProfile
Int -> ReadS DisassociateIamInstanceProfile
ReadS [DisassociateIamInstanceProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateIamInstanceProfile]
$creadListPrec :: ReadPrec [DisassociateIamInstanceProfile]
readPrec :: ReadPrec DisassociateIamInstanceProfile
$creadPrec :: ReadPrec DisassociateIamInstanceProfile
readList :: ReadS [DisassociateIamInstanceProfile]
$creadList :: ReadS [DisassociateIamInstanceProfile]
readsPrec :: Int -> ReadS DisassociateIamInstanceProfile
$creadsPrec :: Int -> ReadS DisassociateIamInstanceProfile
Prelude.Read, Int -> DisassociateIamInstanceProfile -> ShowS
[DisassociateIamInstanceProfile] -> ShowS
DisassociateIamInstanceProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateIamInstanceProfile] -> ShowS
$cshowList :: [DisassociateIamInstanceProfile] -> ShowS
show :: DisassociateIamInstanceProfile -> String
$cshow :: DisassociateIamInstanceProfile -> String
showsPrec :: Int -> DisassociateIamInstanceProfile -> ShowS
$cshowsPrec :: Int -> DisassociateIamInstanceProfile -> ShowS
Prelude.Show, forall x.
Rep DisassociateIamInstanceProfile x
-> DisassociateIamInstanceProfile
forall x.
DisassociateIamInstanceProfile
-> Rep DisassociateIamInstanceProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateIamInstanceProfile x
-> DisassociateIamInstanceProfile
$cfrom :: forall x.
DisassociateIamInstanceProfile
-> Rep DisassociateIamInstanceProfile x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateIamInstanceProfile' 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:
--
-- 'associationId', 'disassociateIamInstanceProfile_associationId' - The ID of the IAM instance profile association.
newDisassociateIamInstanceProfile ::
  -- | 'associationId'
  Prelude.Text ->
  DisassociateIamInstanceProfile
newDisassociateIamInstanceProfile :: Text -> DisassociateIamInstanceProfile
newDisassociateIamInstanceProfile Text
pAssociationId_ =
  DisassociateIamInstanceProfile'
    { $sel:associationId:DisassociateIamInstanceProfile' :: Text
associationId =
        Text
pAssociationId_
    }

-- | The ID of the IAM instance profile association.
disassociateIamInstanceProfile_associationId :: Lens.Lens' DisassociateIamInstanceProfile Prelude.Text
disassociateIamInstanceProfile_associationId :: Lens' DisassociateIamInstanceProfile Text
disassociateIamInstanceProfile_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateIamInstanceProfile' {Text
associationId :: Text
$sel:associationId:DisassociateIamInstanceProfile' :: DisassociateIamInstanceProfile -> Text
associationId} -> Text
associationId) (\s :: DisassociateIamInstanceProfile
s@DisassociateIamInstanceProfile' {} Text
a -> DisassociateIamInstanceProfile
s {$sel:associationId:DisassociateIamInstanceProfile' :: Text
associationId = Text
a} :: DisassociateIamInstanceProfile)

instance
  Core.AWSRequest
    DisassociateIamInstanceProfile
  where
  type
    AWSResponse DisassociateIamInstanceProfile =
      DisassociateIamInstanceProfileResponse
  request :: (Service -> Service)
-> DisassociateIamInstanceProfile
-> Request DisassociateIamInstanceProfile
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DisassociateIamInstanceProfile
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DisassociateIamInstanceProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe IamInstanceProfileAssociation
-> Int -> DisassociateIamInstanceProfileResponse
DisassociateIamInstanceProfileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"iamInstanceProfileAssociation")
            forall (f :: * -> *) a b. Applicative f => 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
    DisassociateIamInstanceProfile
  where
  hashWithSalt :: Int -> DisassociateIamInstanceProfile -> Int
hashWithSalt
    Int
_salt
    DisassociateIamInstanceProfile' {Text
associationId :: Text
$sel:associationId:DisassociateIamInstanceProfile' :: DisassociateIamInstanceProfile -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
associationId

instance
  Prelude.NFData
    DisassociateIamInstanceProfile
  where
  rnf :: DisassociateIamInstanceProfile -> ()
rnf DisassociateIamInstanceProfile' {Text
associationId :: Text
$sel:associationId:DisassociateIamInstanceProfile' :: DisassociateIamInstanceProfile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
associationId

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

instance Data.ToPath DisassociateIamInstanceProfile where
  toPath :: DisassociateIamInstanceProfile -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery DisassociateIamInstanceProfile where
  toQuery :: DisassociateIamInstanceProfile -> QueryString
toQuery DisassociateIamInstanceProfile' {Text
associationId :: Text
$sel:associationId:DisassociateIamInstanceProfile' :: DisassociateIamInstanceProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DisassociateIamInstanceProfile" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AssociationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
associationId
      ]

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

-- |
-- Create a value of 'DisassociateIamInstanceProfileResponse' 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:
--
-- 'iamInstanceProfileAssociation', 'disassociateIamInstanceProfileResponse_iamInstanceProfileAssociation' - Information about the IAM instance profile association.
--
-- 'httpStatus', 'disassociateIamInstanceProfileResponse_httpStatus' - The response's http status code.
newDisassociateIamInstanceProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateIamInstanceProfileResponse
newDisassociateIamInstanceProfileResponse :: Int -> DisassociateIamInstanceProfileResponse
newDisassociateIamInstanceProfileResponse
  Int
pHttpStatus_ =
    DisassociateIamInstanceProfileResponse'
      { $sel:iamInstanceProfileAssociation:DisassociateIamInstanceProfileResponse' :: Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DisassociateIamInstanceProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Information about the IAM instance profile association.
disassociateIamInstanceProfileResponse_iamInstanceProfileAssociation :: Lens.Lens' DisassociateIamInstanceProfileResponse (Prelude.Maybe IamInstanceProfileAssociation)
disassociateIamInstanceProfileResponse_iamInstanceProfileAssociation :: Lens'
  DisassociateIamInstanceProfileResponse
  (Maybe IamInstanceProfileAssociation)
disassociateIamInstanceProfileResponse_iamInstanceProfileAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateIamInstanceProfileResponse' {Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation :: Maybe IamInstanceProfileAssociation
$sel:iamInstanceProfileAssociation:DisassociateIamInstanceProfileResponse' :: DisassociateIamInstanceProfileResponse
-> Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation} -> Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation) (\s :: DisassociateIamInstanceProfileResponse
s@DisassociateIamInstanceProfileResponse' {} Maybe IamInstanceProfileAssociation
a -> DisassociateIamInstanceProfileResponse
s {$sel:iamInstanceProfileAssociation:DisassociateIamInstanceProfileResponse' :: Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation = Maybe IamInstanceProfileAssociation
a} :: DisassociateIamInstanceProfileResponse)

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

instance
  Prelude.NFData
    DisassociateIamInstanceProfileResponse
  where
  rnf :: DisassociateIamInstanceProfileResponse -> ()
rnf DisassociateIamInstanceProfileResponse' {Int
Maybe IamInstanceProfileAssociation
httpStatus :: Int
iamInstanceProfileAssociation :: Maybe IamInstanceProfileAssociation
$sel:httpStatus:DisassociateIamInstanceProfileResponse' :: DisassociateIamInstanceProfileResponse -> Int
$sel:iamInstanceProfileAssociation:DisassociateIamInstanceProfileResponse' :: DisassociateIamInstanceProfileResponse
-> Maybe IamInstanceProfileAssociation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe IamInstanceProfileAssociation
iamInstanceProfileAssociation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus