{-# 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.IAM.UpdateSSHPublicKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the status of an IAM user\'s SSH public key to active or inactive.
-- SSH public keys that are inactive cannot be used for authentication.
-- This operation can be used to disable a user\'s SSH public key as part
-- of a key rotation work flow.
--
-- The SSH public key affected by this operation is used only for
-- authenticating the associated IAM user to an CodeCommit repository. For
-- more information about using SSH keys to authenticate to an CodeCommit
-- repository, see
-- <https://docs.aws.amazon.com/codecommit/latest/userguide/setting-up-credentials-ssh.html Set up CodeCommit for SSH connections>
-- in the /CodeCommit User Guide/.
module Amazonka.IAM.UpdateSSHPublicKey
  ( -- * Creating a Request
    UpdateSSHPublicKey (..),
    newUpdateSSHPublicKey,

    -- * Request Lenses
    updateSSHPublicKey_userName,
    updateSSHPublicKey_sSHPublicKeyId,
    updateSSHPublicKey_status,

    -- * Destructuring the Response
    UpdateSSHPublicKeyResponse (..),
    newUpdateSSHPublicKeyResponse,
  )
where

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

-- | /See:/ 'newUpdateSSHPublicKey' smart constructor.
data UpdateSSHPublicKey = UpdateSSHPublicKey'
  { -- | The name of the IAM user associated with the SSH public key.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    UpdateSSHPublicKey -> Text
userName :: Prelude.Text,
    -- | The unique identifier for the SSH public key.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- that can consist of any upper or lowercased letter or digit.
    UpdateSSHPublicKey -> Text
sSHPublicKeyId :: Prelude.Text,
    -- | The status to assign to the SSH public key. @Active@ means that the key
    -- can be used for authentication with an CodeCommit repository. @Inactive@
    -- means that the key cannot be used.
    UpdateSSHPublicKey -> StatusType
status :: StatusType
  }
  deriving (UpdateSSHPublicKey -> UpdateSSHPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSSHPublicKey -> UpdateSSHPublicKey -> Bool
$c/= :: UpdateSSHPublicKey -> UpdateSSHPublicKey -> Bool
== :: UpdateSSHPublicKey -> UpdateSSHPublicKey -> Bool
$c== :: UpdateSSHPublicKey -> UpdateSSHPublicKey -> Bool
Prelude.Eq, ReadPrec [UpdateSSHPublicKey]
ReadPrec UpdateSSHPublicKey
Int -> ReadS UpdateSSHPublicKey
ReadS [UpdateSSHPublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSSHPublicKey]
$creadListPrec :: ReadPrec [UpdateSSHPublicKey]
readPrec :: ReadPrec UpdateSSHPublicKey
$creadPrec :: ReadPrec UpdateSSHPublicKey
readList :: ReadS [UpdateSSHPublicKey]
$creadList :: ReadS [UpdateSSHPublicKey]
readsPrec :: Int -> ReadS UpdateSSHPublicKey
$creadsPrec :: Int -> ReadS UpdateSSHPublicKey
Prelude.Read, Int -> UpdateSSHPublicKey -> ShowS
[UpdateSSHPublicKey] -> ShowS
UpdateSSHPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSSHPublicKey] -> ShowS
$cshowList :: [UpdateSSHPublicKey] -> ShowS
show :: UpdateSSHPublicKey -> String
$cshow :: UpdateSSHPublicKey -> String
showsPrec :: Int -> UpdateSSHPublicKey -> ShowS
$cshowsPrec :: Int -> UpdateSSHPublicKey -> ShowS
Prelude.Show, forall x. Rep UpdateSSHPublicKey x -> UpdateSSHPublicKey
forall x. UpdateSSHPublicKey -> Rep UpdateSSHPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSSHPublicKey x -> UpdateSSHPublicKey
$cfrom :: forall x. UpdateSSHPublicKey -> Rep UpdateSSHPublicKey x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSSHPublicKey' 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:
--
-- 'userName', 'updateSSHPublicKey_userName' - The name of the IAM user associated with the SSH public key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
--
-- 'sSHPublicKeyId', 'updateSSHPublicKey_sSHPublicKeyId' - The unique identifier for the SSH public key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that can consist of any upper or lowercased letter or digit.
--
-- 'status', 'updateSSHPublicKey_status' - The status to assign to the SSH public key. @Active@ means that the key
-- can be used for authentication with an CodeCommit repository. @Inactive@
-- means that the key cannot be used.
newUpdateSSHPublicKey ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'sSHPublicKeyId'
  Prelude.Text ->
  -- | 'status'
  StatusType ->
  UpdateSSHPublicKey
newUpdateSSHPublicKey :: Text -> Text -> StatusType -> UpdateSSHPublicKey
newUpdateSSHPublicKey
  Text
pUserName_
  Text
pSSHPublicKeyId_
  StatusType
pStatus_ =
    UpdateSSHPublicKey'
      { $sel:userName:UpdateSSHPublicKey' :: Text
userName = Text
pUserName_,
        $sel:sSHPublicKeyId:UpdateSSHPublicKey' :: Text
sSHPublicKeyId = Text
pSSHPublicKeyId_,
        $sel:status:UpdateSSHPublicKey' :: StatusType
status = StatusType
pStatus_
      }

-- | The name of the IAM user associated with the SSH public key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
updateSSHPublicKey_userName :: Lens.Lens' UpdateSSHPublicKey Prelude.Text
updateSSHPublicKey_userName :: Lens' UpdateSSHPublicKey Text
updateSSHPublicKey_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSSHPublicKey' {Text
userName :: Text
$sel:userName:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
userName} -> Text
userName) (\s :: UpdateSSHPublicKey
s@UpdateSSHPublicKey' {} Text
a -> UpdateSSHPublicKey
s {$sel:userName:UpdateSSHPublicKey' :: Text
userName = Text
a} :: UpdateSSHPublicKey)

-- | The unique identifier for the SSH public key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that can consist of any upper or lowercased letter or digit.
updateSSHPublicKey_sSHPublicKeyId :: Lens.Lens' UpdateSSHPublicKey Prelude.Text
updateSSHPublicKey_sSHPublicKeyId :: Lens' UpdateSSHPublicKey Text
updateSSHPublicKey_sSHPublicKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSSHPublicKey' {Text
sSHPublicKeyId :: Text
$sel:sSHPublicKeyId:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
sSHPublicKeyId} -> Text
sSHPublicKeyId) (\s :: UpdateSSHPublicKey
s@UpdateSSHPublicKey' {} Text
a -> UpdateSSHPublicKey
s {$sel:sSHPublicKeyId:UpdateSSHPublicKey' :: Text
sSHPublicKeyId = Text
a} :: UpdateSSHPublicKey)

-- | The status to assign to the SSH public key. @Active@ means that the key
-- can be used for authentication with an CodeCommit repository. @Inactive@
-- means that the key cannot be used.
updateSSHPublicKey_status :: Lens.Lens' UpdateSSHPublicKey StatusType
updateSSHPublicKey_status :: Lens' UpdateSSHPublicKey StatusType
updateSSHPublicKey_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSSHPublicKey' {StatusType
status :: StatusType
$sel:status:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> StatusType
status} -> StatusType
status) (\s :: UpdateSSHPublicKey
s@UpdateSSHPublicKey' {} StatusType
a -> UpdateSSHPublicKey
s {$sel:status:UpdateSSHPublicKey' :: StatusType
status = StatusType
a} :: UpdateSSHPublicKey)

instance Core.AWSRequest UpdateSSHPublicKey where
  type
    AWSResponse UpdateSSHPublicKey =
      UpdateSSHPublicKeyResponse
  request :: (Service -> Service)
-> UpdateSSHPublicKey -> Request UpdateSSHPublicKey
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 UpdateSSHPublicKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateSSHPublicKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateSSHPublicKeyResponse
UpdateSSHPublicKeyResponse'

instance Prelude.Hashable UpdateSSHPublicKey where
  hashWithSalt :: Int -> UpdateSSHPublicKey -> Int
hashWithSalt Int
_salt UpdateSSHPublicKey' {Text
StatusType
status :: StatusType
sSHPublicKeyId :: Text
userName :: Text
$sel:status:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> StatusType
$sel:sSHPublicKeyId:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
$sel:userName:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sSHPublicKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StatusType
status

instance Prelude.NFData UpdateSSHPublicKey where
  rnf :: UpdateSSHPublicKey -> ()
rnf UpdateSSHPublicKey' {Text
StatusType
status :: StatusType
sSHPublicKeyId :: Text
userName :: Text
$sel:status:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> StatusType
$sel:sSHPublicKeyId:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
$sel:userName:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sSHPublicKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StatusType
status

instance Data.ToHeaders UpdateSSHPublicKey where
  toHeaders :: UpdateSSHPublicKey -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery UpdateSSHPublicKey where
  toQuery :: UpdateSSHPublicKey -> QueryString
toQuery UpdateSSHPublicKey' {Text
StatusType
status :: StatusType
sSHPublicKeyId :: Text
userName :: Text
$sel:status:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> StatusType
$sel:sSHPublicKeyId:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
$sel:userName:UpdateSSHPublicKey' :: UpdateSSHPublicKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UpdateSSHPublicKey" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
userName,
        ByteString
"SSHPublicKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sSHPublicKeyId,
        ByteString
"Status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: StatusType
status
      ]

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

-- |
-- Create a value of 'UpdateSSHPublicKeyResponse' 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.
newUpdateSSHPublicKeyResponse ::
  UpdateSSHPublicKeyResponse
newUpdateSSHPublicKeyResponse :: UpdateSSHPublicKeyResponse
newUpdateSSHPublicKeyResponse =
  UpdateSSHPublicKeyResponse
UpdateSSHPublicKeyResponse'

instance Prelude.NFData UpdateSSHPublicKeyResponse where
  rnf :: UpdateSSHPublicKeyResponse -> ()
rnf UpdateSSHPublicKeyResponse
_ = ()