{-# 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.GetWorkload
-- 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 an existing workload.
module Amazonka.WellArchitected.GetWorkload
  ( -- * Creating a Request
    GetWorkload (..),
    newGetWorkload,

    -- * Request Lenses
    getWorkload_workloadId,

    -- * Destructuring the Response
    GetWorkloadResponse (..),
    newGetWorkloadResponse,

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

-- |
-- Create a value of 'GetWorkload' 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', 'getWorkload_workloadId' - Undocumented member.
newGetWorkload ::
  -- | 'workloadId'
  Prelude.Text ->
  GetWorkload
newGetWorkload :: Text -> GetWorkload
newGetWorkload Text
pWorkloadId_ =
  GetWorkload' {$sel:workloadId:GetWorkload' :: Text
workloadId = Text
pWorkloadId_}

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

instance Core.AWSRequest GetWorkload where
  type AWSResponse GetWorkload = GetWorkloadResponse
  request :: (Service -> Service) -> GetWorkload -> Request GetWorkload
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 GetWorkload
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetWorkload)))
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 Workload -> Int -> GetWorkloadResponse
GetWorkloadResponse'
            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
"Workload")
            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 GetWorkload where
  hashWithSalt :: Int -> GetWorkload -> Int
hashWithSalt Int
_salt GetWorkload' {Text
workloadId :: Text
$sel:workloadId:GetWorkload' :: GetWorkload -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId

instance Prelude.NFData GetWorkload where
  rnf :: GetWorkload -> ()
rnf GetWorkload' {Text
workloadId :: Text
$sel:workloadId:GetWorkload' :: GetWorkload -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
workloadId

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

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

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

-- |
-- Create a value of 'GetWorkloadResponse' 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:
--
-- 'workload', 'getWorkloadResponse_workload' - Undocumented member.
--
-- 'httpStatus', 'getWorkloadResponse_httpStatus' - The response's http status code.
newGetWorkloadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkloadResponse
newGetWorkloadResponse :: Int -> GetWorkloadResponse
newGetWorkloadResponse Int
pHttpStatus_ =
  GetWorkloadResponse'
    { $sel:workload:GetWorkloadResponse' :: Maybe Workload
workload = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkloadResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getWorkloadResponse_workload :: Lens.Lens' GetWorkloadResponse (Prelude.Maybe Workload)
getWorkloadResponse_workload :: Lens' GetWorkloadResponse (Maybe Workload)
getWorkloadResponse_workload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkloadResponse' {Maybe Workload
workload :: Maybe Workload
$sel:workload:GetWorkloadResponse' :: GetWorkloadResponse -> Maybe Workload
workload} -> Maybe Workload
workload) (\s :: GetWorkloadResponse
s@GetWorkloadResponse' {} Maybe Workload
a -> GetWorkloadResponse
s {$sel:workload:GetWorkloadResponse' :: Maybe Workload
workload = Maybe Workload
a} :: GetWorkloadResponse)

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

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