{-# 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.GetSSHPublicKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the specified SSH public key, including metadata about the
-- key.
--
-- The SSH public key retrieved 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.GetSSHPublicKey
  ( -- * Creating a Request
    GetSSHPublicKey (..),
    newGetSSHPublicKey,

    -- * Request Lenses
    getSSHPublicKey_userName,
    getSSHPublicKey_sSHPublicKeyId,
    getSSHPublicKey_encoding,

    -- * Destructuring the Response
    GetSSHPublicKeyResponse (..),
    newGetSSHPublicKeyResponse,

    -- * Response Lenses
    getSSHPublicKeyResponse_sSHPublicKey,
    getSSHPublicKeyResponse_httpStatus,
  )
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:/ 'newGetSSHPublicKey' smart constructor.
data GetSSHPublicKey = GetSSHPublicKey'
  { -- | 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: _+=,.\@-
    GetSSHPublicKey -> 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.
    GetSSHPublicKey -> Text
sSHPublicKeyId :: Prelude.Text,
    -- | Specifies the public key encoding format to use in the response. To
    -- retrieve the public key in ssh-rsa format, use @SSH@. To retrieve the
    -- public key in PEM format, use @PEM@.
    GetSSHPublicKey -> EncodingType
encoding :: EncodingType
  }
  deriving (GetSSHPublicKey -> GetSSHPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSSHPublicKey -> GetSSHPublicKey -> Bool
$c/= :: GetSSHPublicKey -> GetSSHPublicKey -> Bool
== :: GetSSHPublicKey -> GetSSHPublicKey -> Bool
$c== :: GetSSHPublicKey -> GetSSHPublicKey -> Bool
Prelude.Eq, ReadPrec [GetSSHPublicKey]
ReadPrec GetSSHPublicKey
Int -> ReadS GetSSHPublicKey
ReadS [GetSSHPublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSSHPublicKey]
$creadListPrec :: ReadPrec [GetSSHPublicKey]
readPrec :: ReadPrec GetSSHPublicKey
$creadPrec :: ReadPrec GetSSHPublicKey
readList :: ReadS [GetSSHPublicKey]
$creadList :: ReadS [GetSSHPublicKey]
readsPrec :: Int -> ReadS GetSSHPublicKey
$creadsPrec :: Int -> ReadS GetSSHPublicKey
Prelude.Read, Int -> GetSSHPublicKey -> ShowS
[GetSSHPublicKey] -> ShowS
GetSSHPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSSHPublicKey] -> ShowS
$cshowList :: [GetSSHPublicKey] -> ShowS
show :: GetSSHPublicKey -> String
$cshow :: GetSSHPublicKey -> String
showsPrec :: Int -> GetSSHPublicKey -> ShowS
$cshowsPrec :: Int -> GetSSHPublicKey -> ShowS
Prelude.Show, forall x. Rep GetSSHPublicKey x -> GetSSHPublicKey
forall x. GetSSHPublicKey -> Rep GetSSHPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSSHPublicKey x -> GetSSHPublicKey
$cfrom :: forall x. GetSSHPublicKey -> Rep GetSSHPublicKey x
Prelude.Generic)

-- |
-- Create a value of 'GetSSHPublicKey' 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', 'getSSHPublicKey_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', 'getSSHPublicKey_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.
--
-- 'encoding', 'getSSHPublicKey_encoding' - Specifies the public key encoding format to use in the response. To
-- retrieve the public key in ssh-rsa format, use @SSH@. To retrieve the
-- public key in PEM format, use @PEM@.
newGetSSHPublicKey ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'sSHPublicKeyId'
  Prelude.Text ->
  -- | 'encoding'
  EncodingType ->
  GetSSHPublicKey
newGetSSHPublicKey :: Text -> Text -> EncodingType -> GetSSHPublicKey
newGetSSHPublicKey
  Text
pUserName_
  Text
pSSHPublicKeyId_
  EncodingType
pEncoding_ =
    GetSSHPublicKey'
      { $sel:userName:GetSSHPublicKey' :: Text
userName = Text
pUserName_,
        $sel:sSHPublicKeyId:GetSSHPublicKey' :: Text
sSHPublicKeyId = Text
pSSHPublicKeyId_,
        $sel:encoding:GetSSHPublicKey' :: EncodingType
encoding = EncodingType
pEncoding_
      }

-- | 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: _+=,.\@-
getSSHPublicKey_userName :: Lens.Lens' GetSSHPublicKey Prelude.Text
getSSHPublicKey_userName :: Lens' GetSSHPublicKey Text
getSSHPublicKey_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSSHPublicKey' {Text
userName :: Text
$sel:userName:GetSSHPublicKey' :: GetSSHPublicKey -> Text
userName} -> Text
userName) (\s :: GetSSHPublicKey
s@GetSSHPublicKey' {} Text
a -> GetSSHPublicKey
s {$sel:userName:GetSSHPublicKey' :: Text
userName = Text
a} :: GetSSHPublicKey)

-- | 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.
getSSHPublicKey_sSHPublicKeyId :: Lens.Lens' GetSSHPublicKey Prelude.Text
getSSHPublicKey_sSHPublicKeyId :: Lens' GetSSHPublicKey Text
getSSHPublicKey_sSHPublicKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSSHPublicKey' {Text
sSHPublicKeyId :: Text
$sel:sSHPublicKeyId:GetSSHPublicKey' :: GetSSHPublicKey -> Text
sSHPublicKeyId} -> Text
sSHPublicKeyId) (\s :: GetSSHPublicKey
s@GetSSHPublicKey' {} Text
a -> GetSSHPublicKey
s {$sel:sSHPublicKeyId:GetSSHPublicKey' :: Text
sSHPublicKeyId = Text
a} :: GetSSHPublicKey)

-- | Specifies the public key encoding format to use in the response. To
-- retrieve the public key in ssh-rsa format, use @SSH@. To retrieve the
-- public key in PEM format, use @PEM@.
getSSHPublicKey_encoding :: Lens.Lens' GetSSHPublicKey EncodingType
getSSHPublicKey_encoding :: Lens' GetSSHPublicKey EncodingType
getSSHPublicKey_encoding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSSHPublicKey' {EncodingType
encoding :: EncodingType
$sel:encoding:GetSSHPublicKey' :: GetSSHPublicKey -> EncodingType
encoding} -> EncodingType
encoding) (\s :: GetSSHPublicKey
s@GetSSHPublicKey' {} EncodingType
a -> GetSSHPublicKey
s {$sel:encoding:GetSSHPublicKey' :: EncodingType
encoding = EncodingType
a} :: GetSSHPublicKey)

instance Core.AWSRequest GetSSHPublicKey where
  type
    AWSResponse GetSSHPublicKey =
      GetSSHPublicKeyResponse
  request :: (Service -> Service) -> GetSSHPublicKey -> Request GetSSHPublicKey
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 GetSSHPublicKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSSHPublicKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetSSHPublicKeyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe SSHPublicKey -> Int -> GetSSHPublicKeyResponse
GetSSHPublicKeyResponse'
            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
"SSHPublicKey")
            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 GetSSHPublicKey where
  hashWithSalt :: Int -> GetSSHPublicKey -> Int
hashWithSalt Int
_salt GetSSHPublicKey' {Text
EncodingType
encoding :: EncodingType
sSHPublicKeyId :: Text
userName :: Text
$sel:encoding:GetSSHPublicKey' :: GetSSHPublicKey -> EncodingType
$sel:sSHPublicKeyId:GetSSHPublicKey' :: GetSSHPublicKey -> Text
$sel:userName:GetSSHPublicKey' :: GetSSHPublicKey -> 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` EncodingType
encoding

instance Prelude.NFData GetSSHPublicKey where
  rnf :: GetSSHPublicKey -> ()
rnf GetSSHPublicKey' {Text
EncodingType
encoding :: EncodingType
sSHPublicKeyId :: Text
userName :: Text
$sel:encoding:GetSSHPublicKey' :: GetSSHPublicKey -> EncodingType
$sel:sSHPublicKeyId:GetSSHPublicKey' :: GetSSHPublicKey -> Text
$sel:userName:GetSSHPublicKey' :: GetSSHPublicKey -> 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 EncodingType
encoding

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

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

instance Data.ToQuery GetSSHPublicKey where
  toQuery :: GetSSHPublicKey -> QueryString
toQuery GetSSHPublicKey' {Text
EncodingType
encoding :: EncodingType
sSHPublicKeyId :: Text
userName :: Text
$sel:encoding:GetSSHPublicKey' :: GetSSHPublicKey -> EncodingType
$sel:sSHPublicKeyId:GetSSHPublicKey' :: GetSSHPublicKey -> Text
$sel:userName:GetSSHPublicKey' :: GetSSHPublicKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetSSHPublicKey" :: 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
"Encoding" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: EncodingType
encoding
      ]

-- | Contains the response to a successful GetSSHPublicKey request.
--
-- /See:/ 'newGetSSHPublicKeyResponse' smart constructor.
data GetSSHPublicKeyResponse = GetSSHPublicKeyResponse'
  { -- | A structure containing details about the SSH public key.
    GetSSHPublicKeyResponse -> Maybe SSHPublicKey
sSHPublicKey :: Prelude.Maybe SSHPublicKey,
    -- | The response's http status code.
    GetSSHPublicKeyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSSHPublicKeyResponse -> GetSSHPublicKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSSHPublicKeyResponse -> GetSSHPublicKeyResponse -> Bool
$c/= :: GetSSHPublicKeyResponse -> GetSSHPublicKeyResponse -> Bool
== :: GetSSHPublicKeyResponse -> GetSSHPublicKeyResponse -> Bool
$c== :: GetSSHPublicKeyResponse -> GetSSHPublicKeyResponse -> Bool
Prelude.Eq, ReadPrec [GetSSHPublicKeyResponse]
ReadPrec GetSSHPublicKeyResponse
Int -> ReadS GetSSHPublicKeyResponse
ReadS [GetSSHPublicKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSSHPublicKeyResponse]
$creadListPrec :: ReadPrec [GetSSHPublicKeyResponse]
readPrec :: ReadPrec GetSSHPublicKeyResponse
$creadPrec :: ReadPrec GetSSHPublicKeyResponse
readList :: ReadS [GetSSHPublicKeyResponse]
$creadList :: ReadS [GetSSHPublicKeyResponse]
readsPrec :: Int -> ReadS GetSSHPublicKeyResponse
$creadsPrec :: Int -> ReadS GetSSHPublicKeyResponse
Prelude.Read, Int -> GetSSHPublicKeyResponse -> ShowS
[GetSSHPublicKeyResponse] -> ShowS
GetSSHPublicKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSSHPublicKeyResponse] -> ShowS
$cshowList :: [GetSSHPublicKeyResponse] -> ShowS
show :: GetSSHPublicKeyResponse -> String
$cshow :: GetSSHPublicKeyResponse -> String
showsPrec :: Int -> GetSSHPublicKeyResponse -> ShowS
$cshowsPrec :: Int -> GetSSHPublicKeyResponse -> ShowS
Prelude.Show, forall x. Rep GetSSHPublicKeyResponse x -> GetSSHPublicKeyResponse
forall x. GetSSHPublicKeyResponse -> Rep GetSSHPublicKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSSHPublicKeyResponse x -> GetSSHPublicKeyResponse
$cfrom :: forall x. GetSSHPublicKeyResponse -> Rep GetSSHPublicKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSSHPublicKeyResponse' 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:
--
-- 'sSHPublicKey', 'getSSHPublicKeyResponse_sSHPublicKey' - A structure containing details about the SSH public key.
--
-- 'httpStatus', 'getSSHPublicKeyResponse_httpStatus' - The response's http status code.
newGetSSHPublicKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSSHPublicKeyResponse
newGetSSHPublicKeyResponse :: Int -> GetSSHPublicKeyResponse
newGetSSHPublicKeyResponse Int
pHttpStatus_ =
  GetSSHPublicKeyResponse'
    { $sel:sSHPublicKey:GetSSHPublicKeyResponse' :: Maybe SSHPublicKey
sSHPublicKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSSHPublicKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure containing details about the SSH public key.
getSSHPublicKeyResponse_sSHPublicKey :: Lens.Lens' GetSSHPublicKeyResponse (Prelude.Maybe SSHPublicKey)
getSSHPublicKeyResponse_sSHPublicKey :: Lens' GetSSHPublicKeyResponse (Maybe SSHPublicKey)
getSSHPublicKeyResponse_sSHPublicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSSHPublicKeyResponse' {Maybe SSHPublicKey
sSHPublicKey :: Maybe SSHPublicKey
$sel:sSHPublicKey:GetSSHPublicKeyResponse' :: GetSSHPublicKeyResponse -> Maybe SSHPublicKey
sSHPublicKey} -> Maybe SSHPublicKey
sSHPublicKey) (\s :: GetSSHPublicKeyResponse
s@GetSSHPublicKeyResponse' {} Maybe SSHPublicKey
a -> GetSSHPublicKeyResponse
s {$sel:sSHPublicKey:GetSSHPublicKeyResponse' :: Maybe SSHPublicKey
sSHPublicKey = Maybe SSHPublicKey
a} :: GetSSHPublicKeyResponse)

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

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