{-# 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.WellArchitected.CreateMilestone
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a milestone for an existing workload.
module Amazonka.WellArchitected.CreateMilestone
  ( -- * Creating a Request
    CreateMilestone (..),
    newCreateMilestone,

    -- * Request Lenses
    createMilestone_workloadId,
    createMilestone_milestoneName,
    createMilestone_clientRequestToken,

    -- * Destructuring the Response
    CreateMilestoneResponse (..),
    newCreateMilestoneResponse,

    -- * Response Lenses
    createMilestoneResponse_milestoneNumber,
    createMilestoneResponse_workloadId,
    createMilestoneResponse_httpStatus,
  )
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.WellArchitected.Types

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

-- |
-- Create a value of 'CreateMilestone' 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:
--
-- 'workloadId', 'createMilestone_workloadId' - Undocumented member.
--
-- 'milestoneName', 'createMilestone_milestoneName' - Undocumented member.
--
-- 'clientRequestToken', 'createMilestone_clientRequestToken' - Undocumented member.
newCreateMilestone ::
  -- | 'workloadId'
  Prelude.Text ->
  -- | 'milestoneName'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateMilestone
newCreateMilestone :: Text -> Text -> Text -> CreateMilestone
newCreateMilestone
  Text
pWorkloadId_
  Text
pMilestoneName_
  Text
pClientRequestToken_ =
    CreateMilestone'
      { $sel:workloadId:CreateMilestone' :: Text
workloadId = Text
pWorkloadId_,
        $sel:milestoneName:CreateMilestone' :: Text
milestoneName = Text
pMilestoneName_,
        $sel:clientRequestToken:CreateMilestone' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

-- | Undocumented member.
createMilestone_workloadId :: Lens.Lens' CreateMilestone Prelude.Text
createMilestone_workloadId :: Lens' CreateMilestone Text
createMilestone_workloadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMilestone' {Text
workloadId :: Text
$sel:workloadId:CreateMilestone' :: CreateMilestone -> Text
workloadId} -> Text
workloadId) (\s :: CreateMilestone
s@CreateMilestone' {} Text
a -> CreateMilestone
s {$sel:workloadId:CreateMilestone' :: Text
workloadId = Text
a} :: CreateMilestone)

-- | Undocumented member.
createMilestone_milestoneName :: Lens.Lens' CreateMilestone Prelude.Text
createMilestone_milestoneName :: Lens' CreateMilestone Text
createMilestone_milestoneName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMilestone' {Text
milestoneName :: Text
$sel:milestoneName:CreateMilestone' :: CreateMilestone -> Text
milestoneName} -> Text
milestoneName) (\s :: CreateMilestone
s@CreateMilestone' {} Text
a -> CreateMilestone
s {$sel:milestoneName:CreateMilestone' :: Text
milestoneName = Text
a} :: CreateMilestone)

-- | Undocumented member.
createMilestone_clientRequestToken :: Lens.Lens' CreateMilestone Prelude.Text
createMilestone_clientRequestToken :: Lens' CreateMilestone Text
createMilestone_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMilestone' {Text
clientRequestToken :: Text
$sel:clientRequestToken:CreateMilestone' :: CreateMilestone -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: CreateMilestone
s@CreateMilestone' {} Text
a -> CreateMilestone
s {$sel:clientRequestToken:CreateMilestone' :: Text
clientRequestToken = Text
a} :: CreateMilestone)

instance Core.AWSRequest CreateMilestone where
  type
    AWSResponse CreateMilestone =
      CreateMilestoneResponse
  request :: (Service -> Service) -> CreateMilestone -> Request CreateMilestone
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 CreateMilestone
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateMilestone)))
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 Natural -> Maybe Text -> Int -> CreateMilestoneResponse
CreateMilestoneResponse'
            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
"MilestoneNumber")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"WorkloadId")
            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 CreateMilestone where
  hashWithSalt :: Int -> CreateMilestone -> Int
hashWithSalt Int
_salt CreateMilestone' {Text
clientRequestToken :: Text
milestoneName :: Text
workloadId :: Text
$sel:clientRequestToken:CreateMilestone' :: CreateMilestone -> Text
$sel:milestoneName:CreateMilestone' :: CreateMilestone -> Text
$sel:workloadId:CreateMilestone' :: CreateMilestone -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
milestoneName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateMilestone where
  rnf :: CreateMilestone -> ()
rnf CreateMilestone' {Text
clientRequestToken :: Text
milestoneName :: Text
workloadId :: Text
$sel:clientRequestToken:CreateMilestone' :: CreateMilestone -> Text
$sel:milestoneName:CreateMilestone' :: CreateMilestone -> Text
$sel:workloadId:CreateMilestone' :: CreateMilestone -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workloadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
milestoneName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

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

instance Data.ToPath CreateMilestone where
  toPath :: CreateMilestone -> ByteString
toPath CreateMilestone' {Text
clientRequestToken :: Text
milestoneName :: Text
workloadId :: Text
$sel:clientRequestToken:CreateMilestone' :: CreateMilestone -> Text
$sel:milestoneName:CreateMilestone' :: CreateMilestone -> Text
$sel:workloadId:CreateMilestone' :: CreateMilestone -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/workloads/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
workloadId, ByteString
"/milestones"]

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

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

-- |
-- Create a value of 'CreateMilestoneResponse' 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:
--
-- 'milestoneNumber', 'createMilestoneResponse_milestoneNumber' - Undocumented member.
--
-- 'workloadId', 'createMilestoneResponse_workloadId' - Undocumented member.
--
-- 'httpStatus', 'createMilestoneResponse_httpStatus' - The response's http status code.
newCreateMilestoneResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMilestoneResponse
newCreateMilestoneResponse :: Int -> CreateMilestoneResponse
newCreateMilestoneResponse Int
pHttpStatus_ =
  CreateMilestoneResponse'
    { $sel:milestoneNumber:CreateMilestoneResponse' :: Maybe Natural
milestoneNumber =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workloadId:CreateMilestoneResponse' :: Maybe Text
workloadId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMilestoneResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createMilestoneResponse_milestoneNumber :: Lens.Lens' CreateMilestoneResponse (Prelude.Maybe Prelude.Natural)
createMilestoneResponse_milestoneNumber :: Lens' CreateMilestoneResponse (Maybe Natural)
createMilestoneResponse_milestoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMilestoneResponse' {Maybe Natural
milestoneNumber :: Maybe Natural
$sel:milestoneNumber:CreateMilestoneResponse' :: CreateMilestoneResponse -> Maybe Natural
milestoneNumber} -> Maybe Natural
milestoneNumber) (\s :: CreateMilestoneResponse
s@CreateMilestoneResponse' {} Maybe Natural
a -> CreateMilestoneResponse
s {$sel:milestoneNumber:CreateMilestoneResponse' :: Maybe Natural
milestoneNumber = Maybe Natural
a} :: CreateMilestoneResponse)

-- | Undocumented member.
createMilestoneResponse_workloadId :: Lens.Lens' CreateMilestoneResponse (Prelude.Maybe Prelude.Text)
createMilestoneResponse_workloadId :: Lens' CreateMilestoneResponse (Maybe Text)
createMilestoneResponse_workloadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMilestoneResponse' {Maybe Text
workloadId :: Maybe Text
$sel:workloadId:CreateMilestoneResponse' :: CreateMilestoneResponse -> Maybe Text
workloadId} -> Maybe Text
workloadId) (\s :: CreateMilestoneResponse
s@CreateMilestoneResponse' {} Maybe Text
a -> CreateMilestoneResponse
s {$sel:workloadId:CreateMilestoneResponse' :: Maybe Text
workloadId = Maybe Text
a} :: CreateMilestoneResponse)

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

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