{-# 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.SSM.GetParameter
-- 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 information about a single parameter by specifying the parameter
-- name.
--
-- To get information about more than one parameter at a time, use the
-- GetParameters operation.
module Amazonka.SSM.GetParameter
  ( -- * Creating a Request
    GetParameter (..),
    newGetParameter,

    -- * Request Lenses
    getParameter_withDecryption,
    getParameter_name,

    -- * Destructuring the Response
    GetParameterResponse (..),
    newGetParameterResponse,

    -- * Response Lenses
    getParameterResponse_httpStatus,
    getParameterResponse_parameter,
  )
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.SSM.Types

-- | /See:/ 'newGetParameter' smart constructor.
data GetParameter = GetParameter'
  { -- | Return decrypted values for secure string parameters. This flag is
    -- ignored for @String@ and @StringList@ parameter types.
    GetParameter -> Maybe Bool
withDecryption :: Prelude.Maybe Prelude.Bool,
    -- | The name of the parameter you want to query.
    --
    -- To query by parameter label, use @\"Name\": \"name:label\"@. To query by
    -- parameter version, use @\"Name\": \"name:version\"@.
    GetParameter -> Text
name :: Prelude.Text
  }
  deriving (GetParameter -> GetParameter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetParameter -> GetParameter -> Bool
$c/= :: GetParameter -> GetParameter -> Bool
== :: GetParameter -> GetParameter -> Bool
$c== :: GetParameter -> GetParameter -> Bool
Prelude.Eq, ReadPrec [GetParameter]
ReadPrec GetParameter
Int -> ReadS GetParameter
ReadS [GetParameter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetParameter]
$creadListPrec :: ReadPrec [GetParameter]
readPrec :: ReadPrec GetParameter
$creadPrec :: ReadPrec GetParameter
readList :: ReadS [GetParameter]
$creadList :: ReadS [GetParameter]
readsPrec :: Int -> ReadS GetParameter
$creadsPrec :: Int -> ReadS GetParameter
Prelude.Read, Int -> GetParameter -> ShowS
[GetParameter] -> ShowS
GetParameter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetParameter] -> ShowS
$cshowList :: [GetParameter] -> ShowS
show :: GetParameter -> String
$cshow :: GetParameter -> String
showsPrec :: Int -> GetParameter -> ShowS
$cshowsPrec :: Int -> GetParameter -> ShowS
Prelude.Show, forall x. Rep GetParameter x -> GetParameter
forall x. GetParameter -> Rep GetParameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetParameter x -> GetParameter
$cfrom :: forall x. GetParameter -> Rep GetParameter x
Prelude.Generic)

-- |
-- Create a value of 'GetParameter' 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:
--
-- 'withDecryption', 'getParameter_withDecryption' - Return decrypted values for secure string parameters. This flag is
-- ignored for @String@ and @StringList@ parameter types.
--
-- 'name', 'getParameter_name' - The name of the parameter you want to query.
--
-- To query by parameter label, use @\"Name\": \"name:label\"@. To query by
-- parameter version, use @\"Name\": \"name:version\"@.
newGetParameter ::
  -- | 'name'
  Prelude.Text ->
  GetParameter
newGetParameter :: Text -> GetParameter
newGetParameter Text
pName_ =
  GetParameter'
    { $sel:withDecryption:GetParameter' :: Maybe Bool
withDecryption = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetParameter' :: Text
name = Text
pName_
    }

-- | Return decrypted values for secure string parameters. This flag is
-- ignored for @String@ and @StringList@ parameter types.
getParameter_withDecryption :: Lens.Lens' GetParameter (Prelude.Maybe Prelude.Bool)
getParameter_withDecryption :: Lens' GetParameter (Maybe Bool)
getParameter_withDecryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParameter' {Maybe Bool
withDecryption :: Maybe Bool
$sel:withDecryption:GetParameter' :: GetParameter -> Maybe Bool
withDecryption} -> Maybe Bool
withDecryption) (\s :: GetParameter
s@GetParameter' {} Maybe Bool
a -> GetParameter
s {$sel:withDecryption:GetParameter' :: Maybe Bool
withDecryption = Maybe Bool
a} :: GetParameter)

-- | The name of the parameter you want to query.
--
-- To query by parameter label, use @\"Name\": \"name:label\"@. To query by
-- parameter version, use @\"Name\": \"name:version\"@.
getParameter_name :: Lens.Lens' GetParameter Prelude.Text
getParameter_name :: Lens' GetParameter Text
getParameter_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParameter' {Text
name :: Text
$sel:name:GetParameter' :: GetParameter -> Text
name} -> Text
name) (\s :: GetParameter
s@GetParameter' {} Text
a -> GetParameter
s {$sel:name:GetParameter' :: Text
name = Text
a} :: GetParameter)

instance Core.AWSRequest GetParameter where
  type AWSResponse GetParameter = GetParameterResponse
  request :: (Service -> Service) -> GetParameter -> Request GetParameter
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 GetParameter
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetParameter)))
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 ->
          Int -> Parameter -> GetParameterResponse
GetParameterResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Parameter")
      )

instance Prelude.Hashable GetParameter where
  hashWithSalt :: Int -> GetParameter -> Int
hashWithSalt Int
_salt GetParameter' {Maybe Bool
Text
name :: Text
withDecryption :: Maybe Bool
$sel:name:GetParameter' :: GetParameter -> Text
$sel:withDecryption:GetParameter' :: GetParameter -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
withDecryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetParameter where
  rnf :: GetParameter -> ()
rnf GetParameter' {Maybe Bool
Text
name :: Text
withDecryption :: Maybe Bool
$sel:name:GetParameter' :: GetParameter -> Text
$sel:withDecryption:GetParameter' :: GetParameter -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
withDecryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON GetParameter where
  toJSON :: GetParameter -> Value
toJSON GetParameter' {Maybe Bool
Text
name :: Text
withDecryption :: Maybe Bool
$sel:name:GetParameter' :: GetParameter -> Text
$sel:withDecryption:GetParameter' :: GetParameter -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"WithDecryption" 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 Bool
withDecryption,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newGetParameterResponse' smart constructor.
data GetParameterResponse = GetParameterResponse'
  { -- | The response's http status code.
    GetParameterResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about a parameter.
    GetParameterResponse -> Parameter
parameter :: Parameter
  }
  deriving (GetParameterResponse -> GetParameterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetParameterResponse -> GetParameterResponse -> Bool
$c/= :: GetParameterResponse -> GetParameterResponse -> Bool
== :: GetParameterResponse -> GetParameterResponse -> Bool
$c== :: GetParameterResponse -> GetParameterResponse -> Bool
Prelude.Eq, Int -> GetParameterResponse -> ShowS
[GetParameterResponse] -> ShowS
GetParameterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetParameterResponse] -> ShowS
$cshowList :: [GetParameterResponse] -> ShowS
show :: GetParameterResponse -> String
$cshow :: GetParameterResponse -> String
showsPrec :: Int -> GetParameterResponse -> ShowS
$cshowsPrec :: Int -> GetParameterResponse -> ShowS
Prelude.Show, forall x. Rep GetParameterResponse x -> GetParameterResponse
forall x. GetParameterResponse -> Rep GetParameterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetParameterResponse x -> GetParameterResponse
$cfrom :: forall x. GetParameterResponse -> Rep GetParameterResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetParameterResponse' 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', 'getParameterResponse_httpStatus' - The response's http status code.
--
-- 'parameter', 'getParameterResponse_parameter' - Information about a parameter.
newGetParameterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'parameter'
  Parameter ->
  GetParameterResponse
newGetParameterResponse :: Int -> Parameter -> GetParameterResponse
newGetParameterResponse Int
pHttpStatus_ Parameter
pParameter_ =
  GetParameterResponse'
    { $sel:httpStatus:GetParameterResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:parameter:GetParameterResponse' :: Parameter
parameter = Parameter
pParameter_
    }

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

-- | Information about a parameter.
getParameterResponse_parameter :: Lens.Lens' GetParameterResponse Parameter
getParameterResponse_parameter :: Lens' GetParameterResponse Parameter
getParameterResponse_parameter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParameterResponse' {Parameter
parameter :: Parameter
$sel:parameter:GetParameterResponse' :: GetParameterResponse -> Parameter
parameter} -> Parameter
parameter) (\s :: GetParameterResponse
s@GetParameterResponse' {} Parameter
a -> GetParameterResponse
s {$sel:parameter:GetParameterResponse' :: Parameter
parameter = Parameter
a} :: GetParameterResponse)

instance Prelude.NFData GetParameterResponse where
  rnf :: GetParameterResponse -> ()
rnf GetParameterResponse' {Int
Parameter
parameter :: Parameter
httpStatus :: Int
$sel:parameter:GetParameterResponse' :: GetParameterResponse -> Parameter
$sel:httpStatus:GetParameterResponse' :: GetParameterResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Parameter
parameter