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

    -- * Request Lenses
    getMilestone_workloadId,
    getMilestone_milestoneNumber,

    -- * Destructuring the Response
    GetMilestoneResponse (..),
    newGetMilestoneResponse,

    -- * Response Lenses
    getMilestoneResponse_milestone,
    getMilestoneResponse_workloadId,
    getMilestoneResponse_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 to get a milestone.
--
-- /See:/ 'newGetMilestone' smart constructor.
data GetMilestone = GetMilestone'
  { GetMilestone -> Text
workloadId :: Prelude.Text,
    GetMilestone -> Natural
milestoneNumber :: Prelude.Natural
  }
  deriving (GetMilestone -> GetMilestone -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMilestone -> GetMilestone -> Bool
$c/= :: GetMilestone -> GetMilestone -> Bool
== :: GetMilestone -> GetMilestone -> Bool
$c== :: GetMilestone -> GetMilestone -> Bool
Prelude.Eq, ReadPrec [GetMilestone]
ReadPrec GetMilestone
Int -> ReadS GetMilestone
ReadS [GetMilestone]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMilestone]
$creadListPrec :: ReadPrec [GetMilestone]
readPrec :: ReadPrec GetMilestone
$creadPrec :: ReadPrec GetMilestone
readList :: ReadS [GetMilestone]
$creadList :: ReadS [GetMilestone]
readsPrec :: Int -> ReadS GetMilestone
$creadsPrec :: Int -> ReadS GetMilestone
Prelude.Read, Int -> GetMilestone -> ShowS
[GetMilestone] -> ShowS
GetMilestone -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMilestone] -> ShowS
$cshowList :: [GetMilestone] -> ShowS
show :: GetMilestone -> String
$cshow :: GetMilestone -> String
showsPrec :: Int -> GetMilestone -> ShowS
$cshowsPrec :: Int -> GetMilestone -> ShowS
Prelude.Show, forall x. Rep GetMilestone x -> GetMilestone
forall x. GetMilestone -> Rep GetMilestone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMilestone x -> GetMilestone
$cfrom :: forall x. GetMilestone -> Rep GetMilestone x
Prelude.Generic)

-- |
-- Create a value of 'GetMilestone' 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', 'getMilestone_workloadId' - Undocumented member.
--
-- 'milestoneNumber', 'getMilestone_milestoneNumber' - Undocumented member.
newGetMilestone ::
  -- | 'workloadId'
  Prelude.Text ->
  -- | 'milestoneNumber'
  Prelude.Natural ->
  GetMilestone
newGetMilestone :: Text -> Natural -> GetMilestone
newGetMilestone Text
pWorkloadId_ Natural
pMilestoneNumber_ =
  GetMilestone'
    { $sel:workloadId:GetMilestone' :: Text
workloadId = Text
pWorkloadId_,
      $sel:milestoneNumber:GetMilestone' :: Natural
milestoneNumber = Natural
pMilestoneNumber_
    }

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

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

instance Core.AWSRequest GetMilestone where
  type AWSResponse GetMilestone = GetMilestoneResponse
  request :: (Service -> Service) -> GetMilestone -> Request GetMilestone
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMilestone
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMilestone)))
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 Milestone -> Maybe Text -> Int -> GetMilestoneResponse
GetMilestoneResponse'
            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
"Milestone")
            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 GetMilestone where
  hashWithSalt :: Int -> GetMilestone -> Int
hashWithSalt Int
_salt GetMilestone' {Natural
Text
milestoneNumber :: Natural
workloadId :: Text
$sel:milestoneNumber:GetMilestone' :: GetMilestone -> Natural
$sel:workloadId:GetMilestone' :: GetMilestone -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
milestoneNumber

instance Prelude.NFData GetMilestone where
  rnf :: GetMilestone -> ()
rnf GetMilestone' {Natural
Text
milestoneNumber :: Natural
workloadId :: Text
$sel:milestoneNumber:GetMilestone' :: GetMilestone -> Natural
$sel:workloadId:GetMilestone' :: GetMilestone -> 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 Natural
milestoneNumber

instance Data.ToHeaders GetMilestone where
  toHeaders :: GetMilestone -> 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.ToPath GetMilestone where
  toPath :: GetMilestone -> ByteString
toPath GetMilestone' {Natural
Text
milestoneNumber :: Natural
workloadId :: Text
$sel:milestoneNumber:GetMilestone' :: GetMilestone -> Natural
$sel:workloadId:GetMilestone' :: GetMilestone -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workloads/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workloadId,
        ByteString
"/milestones/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Natural
milestoneNumber
      ]

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

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

-- |
-- Create a value of 'GetMilestoneResponse' 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:
--
-- 'milestone', 'getMilestoneResponse_milestone' - Undocumented member.
--
-- 'workloadId', 'getMilestoneResponse_workloadId' - Undocumented member.
--
-- 'httpStatus', 'getMilestoneResponse_httpStatus' - The response's http status code.
newGetMilestoneResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMilestoneResponse
newGetMilestoneResponse :: Int -> GetMilestoneResponse
newGetMilestoneResponse Int
pHttpStatus_ =
  GetMilestoneResponse'
    { $sel:milestone:GetMilestoneResponse' :: Maybe Milestone
milestone = forall a. Maybe a
Prelude.Nothing,
      $sel:workloadId:GetMilestoneResponse' :: Maybe Text
workloadId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMilestoneResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getMilestoneResponse_milestone :: Lens.Lens' GetMilestoneResponse (Prelude.Maybe Milestone)
getMilestoneResponse_milestone :: Lens' GetMilestoneResponse (Maybe Milestone)
getMilestoneResponse_milestone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMilestoneResponse' {Maybe Milestone
milestone :: Maybe Milestone
$sel:milestone:GetMilestoneResponse' :: GetMilestoneResponse -> Maybe Milestone
milestone} -> Maybe Milestone
milestone) (\s :: GetMilestoneResponse
s@GetMilestoneResponse' {} Maybe Milestone
a -> GetMilestoneResponse
s {$sel:milestone:GetMilestoneResponse' :: Maybe Milestone
milestone = Maybe Milestone
a} :: GetMilestoneResponse)

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

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

instance Prelude.NFData GetMilestoneResponse where
  rnf :: GetMilestoneResponse -> ()
rnf GetMilestoneResponse' {Int
Maybe Text
Maybe Milestone
httpStatus :: Int
workloadId :: Maybe Text
milestone :: Maybe Milestone
$sel:httpStatus:GetMilestoneResponse' :: GetMilestoneResponse -> Int
$sel:workloadId:GetMilestoneResponse' :: GetMilestoneResponse -> Maybe Text
$sel:milestone:GetMilestoneResponse' :: GetMilestoneResponse -> Maybe Milestone
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Milestone
milestone
      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