{-# 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.DevOpsGuru.StartCostEstimation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts the creation of an estimate of the monthly cost to analyze your
-- Amazon Web Services resources.
module Amazonka.DevOpsGuru.StartCostEstimation
  ( -- * Creating a Request
    StartCostEstimation (..),
    newStartCostEstimation,

    -- * Request Lenses
    startCostEstimation_clientToken,
    startCostEstimation_resourceCollection,

    -- * Destructuring the Response
    StartCostEstimationResponse (..),
    newStartCostEstimationResponse,

    -- * Response Lenses
    startCostEstimationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartCostEstimation' smart constructor.
data StartCostEstimation = StartCostEstimation'
  { -- | The idempotency token used to identify each cost estimate request.
    StartCostEstimation -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The collection of Amazon Web Services resources used to create a monthly
    -- DevOps Guru cost estimate.
    StartCostEstimation -> CostEstimationResourceCollectionFilter
resourceCollection :: CostEstimationResourceCollectionFilter
  }
  deriving (StartCostEstimation -> StartCostEstimation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartCostEstimation -> StartCostEstimation -> Bool
$c/= :: StartCostEstimation -> StartCostEstimation -> Bool
== :: StartCostEstimation -> StartCostEstimation -> Bool
$c== :: StartCostEstimation -> StartCostEstimation -> Bool
Prelude.Eq, ReadPrec [StartCostEstimation]
ReadPrec StartCostEstimation
Int -> ReadS StartCostEstimation
ReadS [StartCostEstimation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartCostEstimation]
$creadListPrec :: ReadPrec [StartCostEstimation]
readPrec :: ReadPrec StartCostEstimation
$creadPrec :: ReadPrec StartCostEstimation
readList :: ReadS [StartCostEstimation]
$creadList :: ReadS [StartCostEstimation]
readsPrec :: Int -> ReadS StartCostEstimation
$creadsPrec :: Int -> ReadS StartCostEstimation
Prelude.Read, Int -> StartCostEstimation -> ShowS
[StartCostEstimation] -> ShowS
StartCostEstimation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartCostEstimation] -> ShowS
$cshowList :: [StartCostEstimation] -> ShowS
show :: StartCostEstimation -> String
$cshow :: StartCostEstimation -> String
showsPrec :: Int -> StartCostEstimation -> ShowS
$cshowsPrec :: Int -> StartCostEstimation -> ShowS
Prelude.Show, forall x. Rep StartCostEstimation x -> StartCostEstimation
forall x. StartCostEstimation -> Rep StartCostEstimation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartCostEstimation x -> StartCostEstimation
$cfrom :: forall x. StartCostEstimation -> Rep StartCostEstimation x
Prelude.Generic)

-- |
-- Create a value of 'StartCostEstimation' 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:
--
-- 'clientToken', 'startCostEstimation_clientToken' - The idempotency token used to identify each cost estimate request.
--
-- 'resourceCollection', 'startCostEstimation_resourceCollection' - The collection of Amazon Web Services resources used to create a monthly
-- DevOps Guru cost estimate.
newStartCostEstimation ::
  -- | 'resourceCollection'
  CostEstimationResourceCollectionFilter ->
  StartCostEstimation
newStartCostEstimation :: CostEstimationResourceCollectionFilter -> StartCostEstimation
newStartCostEstimation CostEstimationResourceCollectionFilter
pResourceCollection_ =
  StartCostEstimation'
    { $sel:clientToken:StartCostEstimation' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceCollection:StartCostEstimation' :: CostEstimationResourceCollectionFilter
resourceCollection = CostEstimationResourceCollectionFilter
pResourceCollection_
    }

-- | The idempotency token used to identify each cost estimate request.
startCostEstimation_clientToken :: Lens.Lens' StartCostEstimation (Prelude.Maybe Prelude.Text)
startCostEstimation_clientToken :: Lens' StartCostEstimation (Maybe Text)
startCostEstimation_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCostEstimation' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StartCostEstimation' :: StartCostEstimation -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StartCostEstimation
s@StartCostEstimation' {} Maybe Text
a -> StartCostEstimation
s {$sel:clientToken:StartCostEstimation' :: Maybe Text
clientToken = Maybe Text
a} :: StartCostEstimation)

-- | The collection of Amazon Web Services resources used to create a monthly
-- DevOps Guru cost estimate.
startCostEstimation_resourceCollection :: Lens.Lens' StartCostEstimation CostEstimationResourceCollectionFilter
startCostEstimation_resourceCollection :: Lens' StartCostEstimation CostEstimationResourceCollectionFilter
startCostEstimation_resourceCollection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCostEstimation' {CostEstimationResourceCollectionFilter
resourceCollection :: CostEstimationResourceCollectionFilter
$sel:resourceCollection:StartCostEstimation' :: StartCostEstimation -> CostEstimationResourceCollectionFilter
resourceCollection} -> CostEstimationResourceCollectionFilter
resourceCollection) (\s :: StartCostEstimation
s@StartCostEstimation' {} CostEstimationResourceCollectionFilter
a -> StartCostEstimation
s {$sel:resourceCollection:StartCostEstimation' :: CostEstimationResourceCollectionFilter
resourceCollection = CostEstimationResourceCollectionFilter
a} :: StartCostEstimation)

instance Core.AWSRequest StartCostEstimation where
  type
    AWSResponse StartCostEstimation =
      StartCostEstimationResponse
  request :: (Service -> Service)
-> StartCostEstimation -> Request StartCostEstimation
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartCostEstimation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartCostEstimation)))
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 -> StartCostEstimationResponse
StartCostEstimationResponse'
            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 StartCostEstimation where
  hashWithSalt :: Int -> StartCostEstimation -> Int
hashWithSalt Int
_salt StartCostEstimation' {Maybe Text
CostEstimationResourceCollectionFilter
resourceCollection :: CostEstimationResourceCollectionFilter
clientToken :: Maybe Text
$sel:resourceCollection:StartCostEstimation' :: StartCostEstimation -> CostEstimationResourceCollectionFilter
$sel:clientToken:StartCostEstimation' :: StartCostEstimation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CostEstimationResourceCollectionFilter
resourceCollection

instance Prelude.NFData StartCostEstimation where
  rnf :: StartCostEstimation -> ()
rnf StartCostEstimation' {Maybe Text
CostEstimationResourceCollectionFilter
resourceCollection :: CostEstimationResourceCollectionFilter
clientToken :: Maybe Text
$sel:resourceCollection:StartCostEstimation' :: StartCostEstimation -> CostEstimationResourceCollectionFilter
$sel:clientToken:StartCostEstimation' :: StartCostEstimation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CostEstimationResourceCollectionFilter
resourceCollection

instance Data.ToHeaders StartCostEstimation where
  toHeaders :: StartCostEstimation -> 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 StartCostEstimation where
  toJSON :: StartCostEstimation -> Value
toJSON StartCostEstimation' {Maybe Text
CostEstimationResourceCollectionFilter
resourceCollection :: CostEstimationResourceCollectionFilter
clientToken :: Maybe Text
$sel:resourceCollection:StartCostEstimation' :: StartCostEstimation -> CostEstimationResourceCollectionFilter
$sel:clientToken:StartCostEstimation' :: StartCostEstimation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ResourceCollection" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CostEstimationResourceCollectionFilter
resourceCollection)
          ]
      )

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

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

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

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

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

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