{-# 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.OpsWorks.DescribeMyUserProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a user\'s SSH information.
--
-- __Required Permissions__: To use this action, an IAM user must have
-- self-management enabled or an attached policy that explicitly grants
-- permissions. For more information about user permissions, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.DescribeMyUserProfile
  ( -- * Creating a Request
    DescribeMyUserProfile (..),
    newDescribeMyUserProfile,

    -- * Destructuring the Response
    DescribeMyUserProfileResponse (..),
    newDescribeMyUserProfileResponse,

    -- * Response Lenses
    describeMyUserProfileResponse_userProfile,
    describeMyUserProfileResponse_httpStatus,
  )
where

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

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

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

instance Core.AWSRequest DescribeMyUserProfile where
  type
    AWSResponse DescribeMyUserProfile =
      DescribeMyUserProfileResponse
  request :: (Service -> Service)
-> DescribeMyUserProfile -> Request DescribeMyUserProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeMyUserProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeMyUserProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe SelfUserProfile -> Int -> DescribeMyUserProfileResponse
DescribeMyUserProfileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UserProfile")
            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 DescribeMyUserProfile where
  hashWithSalt :: Int -> DescribeMyUserProfile -> Int
hashWithSalt Int
_salt DescribeMyUserProfile
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance Data.ToHeaders DescribeMyUserProfile where
  toHeaders :: DescribeMyUserProfile -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OpsWorks_20130218.DescribeMyUserProfile" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

instance Data.ToQuery DescribeMyUserProfile where
  toQuery :: DescribeMyUserProfile -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Contains the response to a @DescribeMyUserProfile@ request.
--
-- /See:/ 'newDescribeMyUserProfileResponse' smart constructor.
data DescribeMyUserProfileResponse = DescribeMyUserProfileResponse'
  { -- | A @UserProfile@ object that describes the user\'s SSH information.
    DescribeMyUserProfileResponse -> Maybe SelfUserProfile
userProfile :: Prelude.Maybe SelfUserProfile,
    -- | The response's http status code.
    DescribeMyUserProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeMyUserProfileResponse
-> DescribeMyUserProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMyUserProfileResponse
-> DescribeMyUserProfileResponse -> Bool
$c/= :: DescribeMyUserProfileResponse
-> DescribeMyUserProfileResponse -> Bool
== :: DescribeMyUserProfileResponse
-> DescribeMyUserProfileResponse -> Bool
$c== :: DescribeMyUserProfileResponse
-> DescribeMyUserProfileResponse -> Bool
Prelude.Eq, ReadPrec [DescribeMyUserProfileResponse]
ReadPrec DescribeMyUserProfileResponse
Int -> ReadS DescribeMyUserProfileResponse
ReadS [DescribeMyUserProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMyUserProfileResponse]
$creadListPrec :: ReadPrec [DescribeMyUserProfileResponse]
readPrec :: ReadPrec DescribeMyUserProfileResponse
$creadPrec :: ReadPrec DescribeMyUserProfileResponse
readList :: ReadS [DescribeMyUserProfileResponse]
$creadList :: ReadS [DescribeMyUserProfileResponse]
readsPrec :: Int -> ReadS DescribeMyUserProfileResponse
$creadsPrec :: Int -> ReadS DescribeMyUserProfileResponse
Prelude.Read, Int -> DescribeMyUserProfileResponse -> ShowS
[DescribeMyUserProfileResponse] -> ShowS
DescribeMyUserProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMyUserProfileResponse] -> ShowS
$cshowList :: [DescribeMyUserProfileResponse] -> ShowS
show :: DescribeMyUserProfileResponse -> String
$cshow :: DescribeMyUserProfileResponse -> String
showsPrec :: Int -> DescribeMyUserProfileResponse -> ShowS
$cshowsPrec :: Int -> DescribeMyUserProfileResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeMyUserProfileResponse x
-> DescribeMyUserProfileResponse
forall x.
DescribeMyUserProfileResponse
-> Rep DescribeMyUserProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMyUserProfileResponse x
-> DescribeMyUserProfileResponse
$cfrom :: forall x.
DescribeMyUserProfileResponse
-> Rep DescribeMyUserProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMyUserProfileResponse' 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:
--
-- 'userProfile', 'describeMyUserProfileResponse_userProfile' - A @UserProfile@ object that describes the user\'s SSH information.
--
-- 'httpStatus', 'describeMyUserProfileResponse_httpStatus' - The response's http status code.
newDescribeMyUserProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeMyUserProfileResponse
newDescribeMyUserProfileResponse :: Int -> DescribeMyUserProfileResponse
newDescribeMyUserProfileResponse Int
pHttpStatus_ =
  DescribeMyUserProfileResponse'
    { $sel:userProfile:DescribeMyUserProfileResponse' :: Maybe SelfUserProfile
userProfile =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeMyUserProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A @UserProfile@ object that describes the user\'s SSH information.
describeMyUserProfileResponse_userProfile :: Lens.Lens' DescribeMyUserProfileResponse (Prelude.Maybe SelfUserProfile)
describeMyUserProfileResponse_userProfile :: Lens' DescribeMyUserProfileResponse (Maybe SelfUserProfile)
describeMyUserProfileResponse_userProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMyUserProfileResponse' {Maybe SelfUserProfile
userProfile :: Maybe SelfUserProfile
$sel:userProfile:DescribeMyUserProfileResponse' :: DescribeMyUserProfileResponse -> Maybe SelfUserProfile
userProfile} -> Maybe SelfUserProfile
userProfile) (\s :: DescribeMyUserProfileResponse
s@DescribeMyUserProfileResponse' {} Maybe SelfUserProfile
a -> DescribeMyUserProfileResponse
s {$sel:userProfile:DescribeMyUserProfileResponse' :: Maybe SelfUserProfile
userProfile = Maybe SelfUserProfile
a} :: DescribeMyUserProfileResponse)

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

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