{-# 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.ApplicationCostProfiler.PutReportDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates the report definition for a report in Application Cost Profiler.
module Amazonka.ApplicationCostProfiler.PutReportDefinition
  ( -- * Creating a Request
    PutReportDefinition (..),
    newPutReportDefinition,

    -- * Request Lenses
    putReportDefinition_reportId,
    putReportDefinition_reportDescription,
    putReportDefinition_reportFrequency,
    putReportDefinition_format,
    putReportDefinition_destinationS3Location,

    -- * Destructuring the Response
    PutReportDefinitionResponse (..),
    newPutReportDefinitionResponse,

    -- * Response Lenses
    putReportDefinitionResponse_reportId,
    putReportDefinitionResponse_httpStatus,
  )
where

import Amazonka.ApplicationCostProfiler.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

-- | /See:/ 'newPutReportDefinition' smart constructor.
data PutReportDefinition = PutReportDefinition'
  { -- | Required. ID of the report. You can choose any valid string matching the
    -- pattern for the ID.
    PutReportDefinition -> Text
reportId :: Prelude.Text,
    -- | Required. Description of the report.
    PutReportDefinition -> Text
reportDescription :: Prelude.Text,
    -- | Required. The cadence to generate the report.
    PutReportDefinition -> ReportFrequency
reportFrequency :: ReportFrequency,
    -- | Required. The format to use for the generated report.
    PutReportDefinition -> Format
format :: Format,
    -- | Required. Amazon Simple Storage Service (Amazon S3) location where
    -- Application Cost Profiler uploads the report.
    PutReportDefinition -> S3Location
destinationS3Location :: S3Location
  }
  deriving (PutReportDefinition -> PutReportDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutReportDefinition -> PutReportDefinition -> Bool
$c/= :: PutReportDefinition -> PutReportDefinition -> Bool
== :: PutReportDefinition -> PutReportDefinition -> Bool
$c== :: PutReportDefinition -> PutReportDefinition -> Bool
Prelude.Eq, ReadPrec [PutReportDefinition]
ReadPrec PutReportDefinition
Int -> ReadS PutReportDefinition
ReadS [PutReportDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutReportDefinition]
$creadListPrec :: ReadPrec [PutReportDefinition]
readPrec :: ReadPrec PutReportDefinition
$creadPrec :: ReadPrec PutReportDefinition
readList :: ReadS [PutReportDefinition]
$creadList :: ReadS [PutReportDefinition]
readsPrec :: Int -> ReadS PutReportDefinition
$creadsPrec :: Int -> ReadS PutReportDefinition
Prelude.Read, Int -> PutReportDefinition -> ShowS
[PutReportDefinition] -> ShowS
PutReportDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutReportDefinition] -> ShowS
$cshowList :: [PutReportDefinition] -> ShowS
show :: PutReportDefinition -> String
$cshow :: PutReportDefinition -> String
showsPrec :: Int -> PutReportDefinition -> ShowS
$cshowsPrec :: Int -> PutReportDefinition -> ShowS
Prelude.Show, forall x. Rep PutReportDefinition x -> PutReportDefinition
forall x. PutReportDefinition -> Rep PutReportDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutReportDefinition x -> PutReportDefinition
$cfrom :: forall x. PutReportDefinition -> Rep PutReportDefinition x
Prelude.Generic)

-- |
-- Create a value of 'PutReportDefinition' 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:
--
-- 'reportId', 'putReportDefinition_reportId' - Required. ID of the report. You can choose any valid string matching the
-- pattern for the ID.
--
-- 'reportDescription', 'putReportDefinition_reportDescription' - Required. Description of the report.
--
-- 'reportFrequency', 'putReportDefinition_reportFrequency' - Required. The cadence to generate the report.
--
-- 'format', 'putReportDefinition_format' - Required. The format to use for the generated report.
--
-- 'destinationS3Location', 'putReportDefinition_destinationS3Location' - Required. Amazon Simple Storage Service (Amazon S3) location where
-- Application Cost Profiler uploads the report.
newPutReportDefinition ::
  -- | 'reportId'
  Prelude.Text ->
  -- | 'reportDescription'
  Prelude.Text ->
  -- | 'reportFrequency'
  ReportFrequency ->
  -- | 'format'
  Format ->
  -- | 'destinationS3Location'
  S3Location ->
  PutReportDefinition
newPutReportDefinition :: Text
-> Text
-> ReportFrequency
-> Format
-> S3Location
-> PutReportDefinition
newPutReportDefinition
  Text
pReportId_
  Text
pReportDescription_
  ReportFrequency
pReportFrequency_
  Format
pFormat_
  S3Location
pDestinationS3Location_ =
    PutReportDefinition'
      { $sel:reportId:PutReportDefinition' :: Text
reportId = Text
pReportId_,
        $sel:reportDescription:PutReportDefinition' :: Text
reportDescription = Text
pReportDescription_,
        $sel:reportFrequency:PutReportDefinition' :: ReportFrequency
reportFrequency = ReportFrequency
pReportFrequency_,
        $sel:format:PutReportDefinition' :: Format
format = Format
pFormat_,
        $sel:destinationS3Location:PutReportDefinition' :: S3Location
destinationS3Location = S3Location
pDestinationS3Location_
      }

-- | Required. ID of the report. You can choose any valid string matching the
-- pattern for the ID.
putReportDefinition_reportId :: Lens.Lens' PutReportDefinition Prelude.Text
putReportDefinition_reportId :: Lens' PutReportDefinition Text
putReportDefinition_reportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinition' {Text
reportId :: Text
$sel:reportId:PutReportDefinition' :: PutReportDefinition -> Text
reportId} -> Text
reportId) (\s :: PutReportDefinition
s@PutReportDefinition' {} Text
a -> PutReportDefinition
s {$sel:reportId:PutReportDefinition' :: Text
reportId = Text
a} :: PutReportDefinition)

-- | Required. Description of the report.
putReportDefinition_reportDescription :: Lens.Lens' PutReportDefinition Prelude.Text
putReportDefinition_reportDescription :: Lens' PutReportDefinition Text
putReportDefinition_reportDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinition' {Text
reportDescription :: Text
$sel:reportDescription:PutReportDefinition' :: PutReportDefinition -> Text
reportDescription} -> Text
reportDescription) (\s :: PutReportDefinition
s@PutReportDefinition' {} Text
a -> PutReportDefinition
s {$sel:reportDescription:PutReportDefinition' :: Text
reportDescription = Text
a} :: PutReportDefinition)

-- | Required. The cadence to generate the report.
putReportDefinition_reportFrequency :: Lens.Lens' PutReportDefinition ReportFrequency
putReportDefinition_reportFrequency :: Lens' PutReportDefinition ReportFrequency
putReportDefinition_reportFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinition' {ReportFrequency
reportFrequency :: ReportFrequency
$sel:reportFrequency:PutReportDefinition' :: PutReportDefinition -> ReportFrequency
reportFrequency} -> ReportFrequency
reportFrequency) (\s :: PutReportDefinition
s@PutReportDefinition' {} ReportFrequency
a -> PutReportDefinition
s {$sel:reportFrequency:PutReportDefinition' :: ReportFrequency
reportFrequency = ReportFrequency
a} :: PutReportDefinition)

-- | Required. The format to use for the generated report.
putReportDefinition_format :: Lens.Lens' PutReportDefinition Format
putReportDefinition_format :: Lens' PutReportDefinition Format
putReportDefinition_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinition' {Format
format :: Format
$sel:format:PutReportDefinition' :: PutReportDefinition -> Format
format} -> Format
format) (\s :: PutReportDefinition
s@PutReportDefinition' {} Format
a -> PutReportDefinition
s {$sel:format:PutReportDefinition' :: Format
format = Format
a} :: PutReportDefinition)

-- | Required. Amazon Simple Storage Service (Amazon S3) location where
-- Application Cost Profiler uploads the report.
putReportDefinition_destinationS3Location :: Lens.Lens' PutReportDefinition S3Location
putReportDefinition_destinationS3Location :: Lens' PutReportDefinition S3Location
putReportDefinition_destinationS3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinition' {S3Location
destinationS3Location :: S3Location
$sel:destinationS3Location:PutReportDefinition' :: PutReportDefinition -> S3Location
destinationS3Location} -> S3Location
destinationS3Location) (\s :: PutReportDefinition
s@PutReportDefinition' {} S3Location
a -> PutReportDefinition
s {$sel:destinationS3Location:PutReportDefinition' :: S3Location
destinationS3Location = S3Location
a} :: PutReportDefinition)

instance Core.AWSRequest PutReportDefinition where
  type
    AWSResponse PutReportDefinition =
      PutReportDefinitionResponse
  request :: (Service -> Service)
-> PutReportDefinition -> Request PutReportDefinition
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 PutReportDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutReportDefinition)))
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 Text -> Int -> PutReportDefinitionResponse
PutReportDefinitionResponse'
            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
"reportId")
            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 PutReportDefinition where
  hashWithSalt :: Int -> PutReportDefinition -> Int
hashWithSalt Int
_salt PutReportDefinition' {Text
Format
ReportFrequency
S3Location
destinationS3Location :: S3Location
format :: Format
reportFrequency :: ReportFrequency
reportDescription :: Text
reportId :: Text
$sel:destinationS3Location:PutReportDefinition' :: PutReportDefinition -> S3Location
$sel:format:PutReportDefinition' :: PutReportDefinition -> Format
$sel:reportFrequency:PutReportDefinition' :: PutReportDefinition -> ReportFrequency
$sel:reportDescription:PutReportDefinition' :: PutReportDefinition -> Text
$sel:reportId:PutReportDefinition' :: PutReportDefinition -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reportId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reportDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReportFrequency
reportFrequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Format
format
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Location
destinationS3Location

instance Prelude.NFData PutReportDefinition where
  rnf :: PutReportDefinition -> ()
rnf PutReportDefinition' {Text
Format
ReportFrequency
S3Location
destinationS3Location :: S3Location
format :: Format
reportFrequency :: ReportFrequency
reportDescription :: Text
reportId :: Text
$sel:destinationS3Location:PutReportDefinition' :: PutReportDefinition -> S3Location
$sel:format:PutReportDefinition' :: PutReportDefinition -> Format
$sel:reportFrequency:PutReportDefinition' :: PutReportDefinition -> ReportFrequency
$sel:reportDescription:PutReportDefinition' :: PutReportDefinition -> Text
$sel:reportId:PutReportDefinition' :: PutReportDefinition -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
reportId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reportDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReportFrequency
reportFrequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Format
format
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Location
destinationS3Location

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

instance Data.ToJSON PutReportDefinition where
  toJSON :: PutReportDefinition -> Value
toJSON PutReportDefinition' {Text
Format
ReportFrequency
S3Location
destinationS3Location :: S3Location
format :: Format
reportFrequency :: ReportFrequency
reportDescription :: Text
reportId :: Text
$sel:destinationS3Location:PutReportDefinition' :: PutReportDefinition -> S3Location
$sel:format:PutReportDefinition' :: PutReportDefinition -> Format
$sel:reportFrequency:PutReportDefinition' :: PutReportDefinition -> ReportFrequency
$sel:reportDescription:PutReportDefinition' :: PutReportDefinition -> Text
$sel:reportId:PutReportDefinition' :: PutReportDefinition -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"reportId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reportId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"reportDescription" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reportDescription),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"reportFrequency" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReportFrequency
reportFrequency),
            forall a. a -> Maybe a
Prelude.Just (Key
"format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Format
format),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"destinationS3Location"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Location
destinationS3Location
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'PutReportDefinitionResponse' 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:
--
-- 'reportId', 'putReportDefinitionResponse_reportId' - ID of the report.
--
-- 'httpStatus', 'putReportDefinitionResponse_httpStatus' - The response's http status code.
newPutReportDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutReportDefinitionResponse
newPutReportDefinitionResponse :: Int -> PutReportDefinitionResponse
newPutReportDefinitionResponse Int
pHttpStatus_ =
  PutReportDefinitionResponse'
    { $sel:reportId:PutReportDefinitionResponse' :: Maybe Text
reportId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutReportDefinitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | ID of the report.
putReportDefinitionResponse_reportId :: Lens.Lens' PutReportDefinitionResponse (Prelude.Maybe Prelude.Text)
putReportDefinitionResponse_reportId :: Lens' PutReportDefinitionResponse (Maybe Text)
putReportDefinitionResponse_reportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutReportDefinitionResponse' {Maybe Text
reportId :: Maybe Text
$sel:reportId:PutReportDefinitionResponse' :: PutReportDefinitionResponse -> Maybe Text
reportId} -> Maybe Text
reportId) (\s :: PutReportDefinitionResponse
s@PutReportDefinitionResponse' {} Maybe Text
a -> PutReportDefinitionResponse
s {$sel:reportId:PutReportDefinitionResponse' :: Maybe Text
reportId = Maybe Text
a} :: PutReportDefinitionResponse)

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

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