{-# 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.CodeGuruProfiler.PostAgentProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Submits profiling data to an aggregated profile of a profiling group. To
-- get an aggregated profile that is created with this profiling data, use
-- <https://docs.aws.amazon.com/codeguru/latest/profiler-api/API_GetProfile.html GetProfile>
-- .
module Amazonka.CodeGuruProfiler.PostAgentProfile
  ( -- * Creating a Request
    PostAgentProfile (..),
    newPostAgentProfile,

    -- * Request Lenses
    postAgentProfile_profileToken,
    postAgentProfile_agentProfile,
    postAgentProfile_contentType,
    postAgentProfile_profilingGroupName,

    -- * Destructuring the Response
    PostAgentProfileResponse (..),
    newPostAgentProfileResponse,

    -- * Response Lenses
    postAgentProfileResponse_httpStatus,
  )
where

import Amazonka.CodeGuruProfiler.Types
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

-- | The structure representing the postAgentProfileRequest.
--
-- /See:/ 'newPostAgentProfile' smart constructor.
data PostAgentProfile = PostAgentProfile'
  { -- | Amazon CodeGuru Profiler uses this universally unique identifier (UUID)
    -- to prevent the accidental submission of duplicate profiling data if
    -- there are failures and retries.
    PostAgentProfile -> Maybe Text
profileToken :: Prelude.Maybe Prelude.Text,
    -- | The submitted profiling data.
    PostAgentProfile -> ByteString
agentProfile :: Prelude.ByteString,
    -- | The format of the submitted profiling data. The format maps to the
    -- @Accept@ and @Content-Type@ headers of the HTTP request. You can specify
    -- one of the following: or the default .
    --
    -- >  <ul> <li> <p> <code>application/json</code> — standard JSON format </p> </li> <li> <p> <code>application/x-amzn-ion</code> — the Amazon Ion data format. For more information, see <a href="http://amzn.github.io/ion-docs/">Amazon Ion</a>. </p> </li> </ul>
    PostAgentProfile -> Text
contentType :: Prelude.Text,
    -- | The name of the profiling group with the aggregated profile that
    -- receives the submitted profiling data.
    PostAgentProfile -> Text
profilingGroupName :: Prelude.Text
  }
  deriving (PostAgentProfile -> PostAgentProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAgentProfile -> PostAgentProfile -> Bool
$c/= :: PostAgentProfile -> PostAgentProfile -> Bool
== :: PostAgentProfile -> PostAgentProfile -> Bool
$c== :: PostAgentProfile -> PostAgentProfile -> Bool
Prelude.Eq, ReadPrec [PostAgentProfile]
ReadPrec PostAgentProfile
Int -> ReadS PostAgentProfile
ReadS [PostAgentProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostAgentProfile]
$creadListPrec :: ReadPrec [PostAgentProfile]
readPrec :: ReadPrec PostAgentProfile
$creadPrec :: ReadPrec PostAgentProfile
readList :: ReadS [PostAgentProfile]
$creadList :: ReadS [PostAgentProfile]
readsPrec :: Int -> ReadS PostAgentProfile
$creadsPrec :: Int -> ReadS PostAgentProfile
Prelude.Read, Int -> PostAgentProfile -> ShowS
[PostAgentProfile] -> ShowS
PostAgentProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAgentProfile] -> ShowS
$cshowList :: [PostAgentProfile] -> ShowS
show :: PostAgentProfile -> String
$cshow :: PostAgentProfile -> String
showsPrec :: Int -> PostAgentProfile -> ShowS
$cshowsPrec :: Int -> PostAgentProfile -> ShowS
Prelude.Show, forall x. Rep PostAgentProfile x -> PostAgentProfile
forall x. PostAgentProfile -> Rep PostAgentProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostAgentProfile x -> PostAgentProfile
$cfrom :: forall x. PostAgentProfile -> Rep PostAgentProfile x
Prelude.Generic)

-- |
-- Create a value of 'PostAgentProfile' 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:
--
-- 'profileToken', 'postAgentProfile_profileToken' - Amazon CodeGuru Profiler uses this universally unique identifier (UUID)
-- to prevent the accidental submission of duplicate profiling data if
-- there are failures and retries.
--
-- 'agentProfile', 'postAgentProfile_agentProfile' - The submitted profiling data.
--
-- 'contentType', 'postAgentProfile_contentType' - The format of the submitted profiling data. The format maps to the
-- @Accept@ and @Content-Type@ headers of the HTTP request. You can specify
-- one of the following: or the default .
--
-- >  <ul> <li> <p> <code>application/json</code> — standard JSON format </p> </li> <li> <p> <code>application/x-amzn-ion</code> — the Amazon Ion data format. For more information, see <a href="http://amzn.github.io/ion-docs/">Amazon Ion</a>. </p> </li> </ul>
--
-- 'profilingGroupName', 'postAgentProfile_profilingGroupName' - The name of the profiling group with the aggregated profile that
-- receives the submitted profiling data.
newPostAgentProfile ::
  -- | 'agentProfile'
  Prelude.ByteString ->
  -- | 'contentType'
  Prelude.Text ->
  -- | 'profilingGroupName'
  Prelude.Text ->
  PostAgentProfile
newPostAgentProfile :: ByteString -> Text -> Text -> PostAgentProfile
newPostAgentProfile
  ByteString
pAgentProfile_
  Text
pContentType_
  Text
pProfilingGroupName_ =
    PostAgentProfile'
      { $sel:profileToken:PostAgentProfile' :: Maybe Text
profileToken = forall a. Maybe a
Prelude.Nothing,
        $sel:agentProfile:PostAgentProfile' :: ByteString
agentProfile = ByteString
pAgentProfile_,
        $sel:contentType:PostAgentProfile' :: Text
contentType = Text
pContentType_,
        $sel:profilingGroupName:PostAgentProfile' :: Text
profilingGroupName = Text
pProfilingGroupName_
      }

-- | Amazon CodeGuru Profiler uses this universally unique identifier (UUID)
-- to prevent the accidental submission of duplicate profiling data if
-- there are failures and retries.
postAgentProfile_profileToken :: Lens.Lens' PostAgentProfile (Prelude.Maybe Prelude.Text)
postAgentProfile_profileToken :: Lens' PostAgentProfile (Maybe Text)
postAgentProfile_profileToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostAgentProfile' {Maybe Text
profileToken :: Maybe Text
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
profileToken} -> Maybe Text
profileToken) (\s :: PostAgentProfile
s@PostAgentProfile' {} Maybe Text
a -> PostAgentProfile
s {$sel:profileToken:PostAgentProfile' :: Maybe Text
profileToken = Maybe Text
a} :: PostAgentProfile)

-- | The submitted profiling data.
postAgentProfile_agentProfile :: Lens.Lens' PostAgentProfile Prelude.ByteString
postAgentProfile_agentProfile :: Lens' PostAgentProfile ByteString
postAgentProfile_agentProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostAgentProfile' {ByteString
agentProfile :: ByteString
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
agentProfile} -> ByteString
agentProfile) (\s :: PostAgentProfile
s@PostAgentProfile' {} ByteString
a -> PostAgentProfile
s {$sel:agentProfile:PostAgentProfile' :: ByteString
agentProfile = ByteString
a} :: PostAgentProfile)

-- | The format of the submitted profiling data. The format maps to the
-- @Accept@ and @Content-Type@ headers of the HTTP request. You can specify
-- one of the following: or the default .
--
-- >  <ul> <li> <p> <code>application/json</code> — standard JSON format </p> </li> <li> <p> <code>application/x-amzn-ion</code> — the Amazon Ion data format. For more information, see <a href="http://amzn.github.io/ion-docs/">Amazon Ion</a>. </p> </li> </ul>
postAgentProfile_contentType :: Lens.Lens' PostAgentProfile Prelude.Text
postAgentProfile_contentType :: Lens' PostAgentProfile Text
postAgentProfile_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostAgentProfile' {Text
contentType :: Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
contentType} -> Text
contentType) (\s :: PostAgentProfile
s@PostAgentProfile' {} Text
a -> PostAgentProfile
s {$sel:contentType:PostAgentProfile' :: Text
contentType = Text
a} :: PostAgentProfile)

-- | The name of the profiling group with the aggregated profile that
-- receives the submitted profiling data.
postAgentProfile_profilingGroupName :: Lens.Lens' PostAgentProfile Prelude.Text
postAgentProfile_profilingGroupName :: Lens' PostAgentProfile Text
postAgentProfile_profilingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostAgentProfile' {Text
profilingGroupName :: Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
profilingGroupName} -> Text
profilingGroupName) (\s :: PostAgentProfile
s@PostAgentProfile' {} Text
a -> PostAgentProfile
s {$sel:profilingGroupName:PostAgentProfile' :: Text
profilingGroupName = Text
a} :: PostAgentProfile)

instance Core.AWSRequest PostAgentProfile where
  type
    AWSResponse PostAgentProfile =
      PostAgentProfileResponse
  request :: (Service -> Service)
-> PostAgentProfile -> Request PostAgentProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.postBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PostAgentProfile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PostAgentProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PostAgentProfileResponse
PostAgentProfileResponse'
            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))
      )

instance Prelude.Hashable PostAgentProfile where
  hashWithSalt :: Int -> PostAgentProfile -> Int
hashWithSalt Int
_salt PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
profileToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ByteString
agentProfile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profilingGroupName

instance Prelude.NFData PostAgentProfile where
  rnf :: PostAgentProfile -> ()
rnf PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ByteString
agentProfile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profilingGroupName

instance Data.ToBody PostAgentProfile where
  toBody :: PostAgentProfile -> RequestBody
toBody PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    forall a. ToBody a => a -> RequestBody
Data.toBody ByteString
agentProfile

instance Data.ToHeaders PostAgentProfile where
  toHeaders :: PostAgentProfile -> ResponseHeaders
toHeaders PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"Content-Type" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
contentType]

instance Data.ToPath PostAgentProfile where
  toPath :: PostAgentProfile -> ByteString
toPath PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/profilingGroups/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
profilingGroupName,
        ByteString
"/agentProfile"
      ]

instance Data.ToQuery PostAgentProfile where
  toQuery :: PostAgentProfile -> QueryString
toQuery PostAgentProfile' {Maybe Text
ByteString
Text
profilingGroupName :: Text
contentType :: Text
agentProfile :: ByteString
profileToken :: Maybe Text
$sel:profilingGroupName:PostAgentProfile' :: PostAgentProfile -> Text
$sel:contentType:PostAgentProfile' :: PostAgentProfile -> Text
$sel:agentProfile:PostAgentProfile' :: PostAgentProfile -> ByteString
$sel:profileToken:PostAgentProfile' :: PostAgentProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"profileToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
profileToken]

-- | The structure representing the postAgentProfileResponse.
--
-- /See:/ 'newPostAgentProfileResponse' smart constructor.
data PostAgentProfileResponse = PostAgentProfileResponse'
  { -- | The response's http status code.
    PostAgentProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PostAgentProfileResponse -> PostAgentProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAgentProfileResponse -> PostAgentProfileResponse -> Bool
$c/= :: PostAgentProfileResponse -> PostAgentProfileResponse -> Bool
== :: PostAgentProfileResponse -> PostAgentProfileResponse -> Bool
$c== :: PostAgentProfileResponse -> PostAgentProfileResponse -> Bool
Prelude.Eq, ReadPrec [PostAgentProfileResponse]
ReadPrec PostAgentProfileResponse
Int -> ReadS PostAgentProfileResponse
ReadS [PostAgentProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostAgentProfileResponse]
$creadListPrec :: ReadPrec [PostAgentProfileResponse]
readPrec :: ReadPrec PostAgentProfileResponse
$creadPrec :: ReadPrec PostAgentProfileResponse
readList :: ReadS [PostAgentProfileResponse]
$creadList :: ReadS [PostAgentProfileResponse]
readsPrec :: Int -> ReadS PostAgentProfileResponse
$creadsPrec :: Int -> ReadS PostAgentProfileResponse
Prelude.Read, Int -> PostAgentProfileResponse -> ShowS
[PostAgentProfileResponse] -> ShowS
PostAgentProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAgentProfileResponse] -> ShowS
$cshowList :: [PostAgentProfileResponse] -> ShowS
show :: PostAgentProfileResponse -> String
$cshow :: PostAgentProfileResponse -> String
showsPrec :: Int -> PostAgentProfileResponse -> ShowS
$cshowsPrec :: Int -> PostAgentProfileResponse -> ShowS
Prelude.Show, forall x.
Rep PostAgentProfileResponse x -> PostAgentProfileResponse
forall x.
PostAgentProfileResponse -> Rep PostAgentProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PostAgentProfileResponse x -> PostAgentProfileResponse
$cfrom :: forall x.
PostAgentProfileResponse -> Rep PostAgentProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'PostAgentProfileResponse' 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', 'postAgentProfileResponse_httpStatus' - The response's http status code.
newPostAgentProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PostAgentProfileResponse
newPostAgentProfileResponse :: Int -> PostAgentProfileResponse
newPostAgentProfileResponse Int
pHttpStatus_ =
  PostAgentProfileResponse'
    { $sel:httpStatus:PostAgentProfileResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData PostAgentProfileResponse where
  rnf :: PostAgentProfileResponse -> ()
rnf PostAgentProfileResponse' {Int
httpStatus :: Int
$sel:httpStatus:PostAgentProfileResponse' :: PostAgentProfileResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus