{-# 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.Transfer.DescribeProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details of the profile that\'s specified by the @ProfileId@.
module Amazonka.Transfer.DescribeProfile
  ( -- * Creating a Request
    DescribeProfile (..),
    newDescribeProfile,

    -- * Request Lenses
    describeProfile_profileId,

    -- * Destructuring the Response
    DescribeProfileResponse (..),
    newDescribeProfileResponse,

    -- * Response Lenses
    describeProfileResponse_httpStatus,
    describeProfileResponse_profile,
  )
where

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

-- | /See:/ 'newDescribeProfile' smart constructor.
data DescribeProfile = DescribeProfile'
  { -- | The identifier of the profile that you want described.
    DescribeProfile -> Text
profileId :: Prelude.Text
  }
  deriving (DescribeProfile -> DescribeProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProfile -> DescribeProfile -> Bool
$c/= :: DescribeProfile -> DescribeProfile -> Bool
== :: DescribeProfile -> DescribeProfile -> Bool
$c== :: DescribeProfile -> DescribeProfile -> Bool
Prelude.Eq, ReadPrec [DescribeProfile]
ReadPrec DescribeProfile
Int -> ReadS DescribeProfile
ReadS [DescribeProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProfile]
$creadListPrec :: ReadPrec [DescribeProfile]
readPrec :: ReadPrec DescribeProfile
$creadPrec :: ReadPrec DescribeProfile
readList :: ReadS [DescribeProfile]
$creadList :: ReadS [DescribeProfile]
readsPrec :: Int -> ReadS DescribeProfile
$creadsPrec :: Int -> ReadS DescribeProfile
Prelude.Read, Int -> DescribeProfile -> ShowS
[DescribeProfile] -> ShowS
DescribeProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProfile] -> ShowS
$cshowList :: [DescribeProfile] -> ShowS
show :: DescribeProfile -> String
$cshow :: DescribeProfile -> String
showsPrec :: Int -> DescribeProfile -> ShowS
$cshowsPrec :: Int -> DescribeProfile -> ShowS
Prelude.Show, forall x. Rep DescribeProfile x -> DescribeProfile
forall x. DescribeProfile -> Rep DescribeProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProfile x -> DescribeProfile
$cfrom :: forall x. DescribeProfile -> Rep DescribeProfile x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProfile' 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:
--
-- 'profileId', 'describeProfile_profileId' - The identifier of the profile that you want described.
newDescribeProfile ::
  -- | 'profileId'
  Prelude.Text ->
  DescribeProfile
newDescribeProfile :: Text -> DescribeProfile
newDescribeProfile Text
pProfileId_ =
  DescribeProfile' {$sel:profileId:DescribeProfile' :: Text
profileId = Text
pProfileId_}

-- | The identifier of the profile that you want described.
describeProfile_profileId :: Lens.Lens' DescribeProfile Prelude.Text
describeProfile_profileId :: Lens' DescribeProfile Text
describeProfile_profileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProfile' {Text
profileId :: Text
$sel:profileId:DescribeProfile' :: DescribeProfile -> Text
profileId} -> Text
profileId) (\s :: DescribeProfile
s@DescribeProfile' {} Text
a -> DescribeProfile
s {$sel:profileId:DescribeProfile' :: Text
profileId = Text
a} :: DescribeProfile)

instance Core.AWSRequest DescribeProfile where
  type
    AWSResponse DescribeProfile =
      DescribeProfileResponse
  request :: (Service -> Service) -> DescribeProfile -> Request DescribeProfile
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 DescribeProfile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeProfile)))
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 ->
          Int -> DescribedProfile -> DescribeProfileResponse
DescribeProfileResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Profile")
      )

instance Prelude.Hashable DescribeProfile where
  hashWithSalt :: Int -> DescribeProfile -> Int
hashWithSalt Int
_salt DescribeProfile' {Text
profileId :: Text
$sel:profileId:DescribeProfile' :: DescribeProfile -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileId

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

instance Data.ToHeaders DescribeProfile where
  toHeaders :: DescribeProfile -> 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
"TransferService.DescribeProfile" ::
                          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 DescribeProfile where
  toJSON :: DescribeProfile -> Value
toJSON DescribeProfile' {Text
profileId :: Text
$sel:profileId:DescribeProfile' :: DescribeProfile -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"ProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
profileId)]
      )

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

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

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

-- |
-- Create a value of 'DescribeProfileResponse' 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', 'describeProfileResponse_httpStatus' - The response's http status code.
--
-- 'profile', 'describeProfileResponse_profile' - The details of the specified profile, returned as an object.
newDescribeProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'profile'
  DescribedProfile ->
  DescribeProfileResponse
newDescribeProfileResponse :: Int -> DescribedProfile -> DescribeProfileResponse
newDescribeProfileResponse Int
pHttpStatus_ DescribedProfile
pProfile_ =
  DescribeProfileResponse'
    { $sel:httpStatus:DescribeProfileResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:profile:DescribeProfileResponse' :: DescribedProfile
profile = DescribedProfile
pProfile_
    }

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

-- | The details of the specified profile, returned as an object.
describeProfileResponse_profile :: Lens.Lens' DescribeProfileResponse DescribedProfile
describeProfileResponse_profile :: Lens' DescribeProfileResponse DescribedProfile
describeProfileResponse_profile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProfileResponse' {DescribedProfile
profile :: DescribedProfile
$sel:profile:DescribeProfileResponse' :: DescribeProfileResponse -> DescribedProfile
profile} -> DescribedProfile
profile) (\s :: DescribeProfileResponse
s@DescribeProfileResponse' {} DescribedProfile
a -> DescribeProfileResponse
s {$sel:profile:DescribeProfileResponse' :: DescribedProfile
profile = DescribedProfile
a} :: DescribeProfileResponse)

instance Prelude.NFData DescribeProfileResponse where
  rnf :: DescribeProfileResponse -> ()
rnf DescribeProfileResponse' {Int
DescribedProfile
profile :: DescribedProfile
httpStatus :: Int
$sel:profile:DescribeProfileResponse' :: DescribeProfileResponse -> DescribedProfile
$sel:httpStatus:DescribeProfileResponse' :: DescribeProfileResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DescribedProfile
profile