{-# 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.CloudFront.GetContinuousDeploymentPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a continuous deployment policy, including metadata (the policy\'s
-- identifier and the date and time when the policy was last modified).
module Amazonka.CloudFront.GetContinuousDeploymentPolicy
  ( -- * Creating a Request
    GetContinuousDeploymentPolicy (..),
    newGetContinuousDeploymentPolicy,

    -- * Request Lenses
    getContinuousDeploymentPolicy_id,

    -- * Destructuring the Response
    GetContinuousDeploymentPolicyResponse (..),
    newGetContinuousDeploymentPolicyResponse,

    -- * Response Lenses
    getContinuousDeploymentPolicyResponse_continuousDeploymentPolicy,
    getContinuousDeploymentPolicyResponse_eTag,
    getContinuousDeploymentPolicyResponse_httpStatus,
  )
where

import Amazonka.CloudFront.Types
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

-- | /See:/ 'newGetContinuousDeploymentPolicy' smart constructor.
data GetContinuousDeploymentPolicy = GetContinuousDeploymentPolicy'
  { -- | The identifier of the continuous deployment policy that you are getting.
    GetContinuousDeploymentPolicy -> Text
id :: Prelude.Text
  }
  deriving (GetContinuousDeploymentPolicy
-> GetContinuousDeploymentPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContinuousDeploymentPolicy
-> GetContinuousDeploymentPolicy -> Bool
$c/= :: GetContinuousDeploymentPolicy
-> GetContinuousDeploymentPolicy -> Bool
== :: GetContinuousDeploymentPolicy
-> GetContinuousDeploymentPolicy -> Bool
$c== :: GetContinuousDeploymentPolicy
-> GetContinuousDeploymentPolicy -> Bool
Prelude.Eq, ReadPrec [GetContinuousDeploymentPolicy]
ReadPrec GetContinuousDeploymentPolicy
Int -> ReadS GetContinuousDeploymentPolicy
ReadS [GetContinuousDeploymentPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContinuousDeploymentPolicy]
$creadListPrec :: ReadPrec [GetContinuousDeploymentPolicy]
readPrec :: ReadPrec GetContinuousDeploymentPolicy
$creadPrec :: ReadPrec GetContinuousDeploymentPolicy
readList :: ReadS [GetContinuousDeploymentPolicy]
$creadList :: ReadS [GetContinuousDeploymentPolicy]
readsPrec :: Int -> ReadS GetContinuousDeploymentPolicy
$creadsPrec :: Int -> ReadS GetContinuousDeploymentPolicy
Prelude.Read, Int -> GetContinuousDeploymentPolicy -> ShowS
[GetContinuousDeploymentPolicy] -> ShowS
GetContinuousDeploymentPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContinuousDeploymentPolicy] -> ShowS
$cshowList :: [GetContinuousDeploymentPolicy] -> ShowS
show :: GetContinuousDeploymentPolicy -> String
$cshow :: GetContinuousDeploymentPolicy -> String
showsPrec :: Int -> GetContinuousDeploymentPolicy -> ShowS
$cshowsPrec :: Int -> GetContinuousDeploymentPolicy -> ShowS
Prelude.Show, forall x.
Rep GetContinuousDeploymentPolicy x
-> GetContinuousDeploymentPolicy
forall x.
GetContinuousDeploymentPolicy
-> Rep GetContinuousDeploymentPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContinuousDeploymentPolicy x
-> GetContinuousDeploymentPolicy
$cfrom :: forall x.
GetContinuousDeploymentPolicy
-> Rep GetContinuousDeploymentPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetContinuousDeploymentPolicy' 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:
--
-- 'id', 'getContinuousDeploymentPolicy_id' - The identifier of the continuous deployment policy that you are getting.
newGetContinuousDeploymentPolicy ::
  -- | 'id'
  Prelude.Text ->
  GetContinuousDeploymentPolicy
newGetContinuousDeploymentPolicy :: Text -> GetContinuousDeploymentPolicy
newGetContinuousDeploymentPolicy Text
pId_ =
  GetContinuousDeploymentPolicy' {$sel:id:GetContinuousDeploymentPolicy' :: Text
id = Text
pId_}

-- | The identifier of the continuous deployment policy that you are getting.
getContinuousDeploymentPolicy_id :: Lens.Lens' GetContinuousDeploymentPolicy Prelude.Text
getContinuousDeploymentPolicy_id :: Lens' GetContinuousDeploymentPolicy Text
getContinuousDeploymentPolicy_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContinuousDeploymentPolicy' {Text
id :: Text
$sel:id:GetContinuousDeploymentPolicy' :: GetContinuousDeploymentPolicy -> Text
id} -> Text
id) (\s :: GetContinuousDeploymentPolicy
s@GetContinuousDeploymentPolicy' {} Text
a -> GetContinuousDeploymentPolicy
s {$sel:id:GetContinuousDeploymentPolicy' :: Text
id = Text
a} :: GetContinuousDeploymentPolicy)

instance
  Core.AWSRequest
    GetContinuousDeploymentPolicy
  where
  type
    AWSResponse GetContinuousDeploymentPolicy =
      GetContinuousDeploymentPolicyResponse
  request :: (Service -> Service)
-> GetContinuousDeploymentPolicy
-> Request GetContinuousDeploymentPolicy
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 GetContinuousDeploymentPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetContinuousDeploymentPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ContinuousDeploymentPolicy
-> Maybe Text -> Int -> GetContinuousDeploymentPolicyResponse
GetContinuousDeploymentPolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"ETag")
            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
    GetContinuousDeploymentPolicy
  where
  hashWithSalt :: Int -> GetContinuousDeploymentPolicy -> Int
hashWithSalt Int
_salt GetContinuousDeploymentPolicy' {Text
id :: Text
$sel:id:GetContinuousDeploymentPolicy' :: GetContinuousDeploymentPolicy -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

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

instance Data.ToHeaders GetContinuousDeploymentPolicy where
  toHeaders :: GetContinuousDeploymentPolicy -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath GetContinuousDeploymentPolicy where
  toPath :: GetContinuousDeploymentPolicy -> ByteString
toPath GetContinuousDeploymentPolicy' {Text
id :: Text
$sel:id:GetContinuousDeploymentPolicy' :: GetContinuousDeploymentPolicy -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-05-31/continuous-deployment-policy/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id
      ]

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

-- | /See:/ 'newGetContinuousDeploymentPolicyResponse' smart constructor.
data GetContinuousDeploymentPolicyResponse = GetContinuousDeploymentPolicyResponse'
  { -- | A continuous deployment policy.
    GetContinuousDeploymentPolicyResponse
-> Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy :: Prelude.Maybe ContinuousDeploymentPolicy,
    -- | The version identifier for the current version of the continuous
    -- deployment policy.
    GetContinuousDeploymentPolicyResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetContinuousDeploymentPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetContinuousDeploymentPolicyResponse
-> GetContinuousDeploymentPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContinuousDeploymentPolicyResponse
-> GetContinuousDeploymentPolicyResponse -> Bool
$c/= :: GetContinuousDeploymentPolicyResponse
-> GetContinuousDeploymentPolicyResponse -> Bool
== :: GetContinuousDeploymentPolicyResponse
-> GetContinuousDeploymentPolicyResponse -> Bool
$c== :: GetContinuousDeploymentPolicyResponse
-> GetContinuousDeploymentPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetContinuousDeploymentPolicyResponse]
ReadPrec GetContinuousDeploymentPolicyResponse
Int -> ReadS GetContinuousDeploymentPolicyResponse
ReadS [GetContinuousDeploymentPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContinuousDeploymentPolicyResponse]
$creadListPrec :: ReadPrec [GetContinuousDeploymentPolicyResponse]
readPrec :: ReadPrec GetContinuousDeploymentPolicyResponse
$creadPrec :: ReadPrec GetContinuousDeploymentPolicyResponse
readList :: ReadS [GetContinuousDeploymentPolicyResponse]
$creadList :: ReadS [GetContinuousDeploymentPolicyResponse]
readsPrec :: Int -> ReadS GetContinuousDeploymentPolicyResponse
$creadsPrec :: Int -> ReadS GetContinuousDeploymentPolicyResponse
Prelude.Read, Int -> GetContinuousDeploymentPolicyResponse -> ShowS
[GetContinuousDeploymentPolicyResponse] -> ShowS
GetContinuousDeploymentPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContinuousDeploymentPolicyResponse] -> ShowS
$cshowList :: [GetContinuousDeploymentPolicyResponse] -> ShowS
show :: GetContinuousDeploymentPolicyResponse -> String
$cshow :: GetContinuousDeploymentPolicyResponse -> String
showsPrec :: Int -> GetContinuousDeploymentPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetContinuousDeploymentPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep GetContinuousDeploymentPolicyResponse x
-> GetContinuousDeploymentPolicyResponse
forall x.
GetContinuousDeploymentPolicyResponse
-> Rep GetContinuousDeploymentPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContinuousDeploymentPolicyResponse x
-> GetContinuousDeploymentPolicyResponse
$cfrom :: forall x.
GetContinuousDeploymentPolicyResponse
-> Rep GetContinuousDeploymentPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContinuousDeploymentPolicyResponse' 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:
--
-- 'continuousDeploymentPolicy', 'getContinuousDeploymentPolicyResponse_continuousDeploymentPolicy' - A continuous deployment policy.
--
-- 'eTag', 'getContinuousDeploymentPolicyResponse_eTag' - The version identifier for the current version of the continuous
-- deployment policy.
--
-- 'httpStatus', 'getContinuousDeploymentPolicyResponse_httpStatus' - The response's http status code.
newGetContinuousDeploymentPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetContinuousDeploymentPolicyResponse
newGetContinuousDeploymentPolicyResponse :: Int -> GetContinuousDeploymentPolicyResponse
newGetContinuousDeploymentPolicyResponse Int
pHttpStatus_ =
  GetContinuousDeploymentPolicyResponse'
    { $sel:continuousDeploymentPolicy:GetContinuousDeploymentPolicyResponse' :: Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:GetContinuousDeploymentPolicyResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetContinuousDeploymentPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A continuous deployment policy.
getContinuousDeploymentPolicyResponse_continuousDeploymentPolicy :: Lens.Lens' GetContinuousDeploymentPolicyResponse (Prelude.Maybe ContinuousDeploymentPolicy)
getContinuousDeploymentPolicyResponse_continuousDeploymentPolicy :: Lens'
  GetContinuousDeploymentPolicyResponse
  (Maybe ContinuousDeploymentPolicy)
getContinuousDeploymentPolicyResponse_continuousDeploymentPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContinuousDeploymentPolicyResponse' {Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy :: Maybe ContinuousDeploymentPolicy
$sel:continuousDeploymentPolicy:GetContinuousDeploymentPolicyResponse' :: GetContinuousDeploymentPolicyResponse
-> Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy} -> Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy) (\s :: GetContinuousDeploymentPolicyResponse
s@GetContinuousDeploymentPolicyResponse' {} Maybe ContinuousDeploymentPolicy
a -> GetContinuousDeploymentPolicyResponse
s {$sel:continuousDeploymentPolicy:GetContinuousDeploymentPolicyResponse' :: Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy = Maybe ContinuousDeploymentPolicy
a} :: GetContinuousDeploymentPolicyResponse)

-- | The version identifier for the current version of the continuous
-- deployment policy.
getContinuousDeploymentPolicyResponse_eTag :: Lens.Lens' GetContinuousDeploymentPolicyResponse (Prelude.Maybe Prelude.Text)
getContinuousDeploymentPolicyResponse_eTag :: Lens' GetContinuousDeploymentPolicyResponse (Maybe Text)
getContinuousDeploymentPolicyResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContinuousDeploymentPolicyResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:GetContinuousDeploymentPolicyResponse' :: GetContinuousDeploymentPolicyResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: GetContinuousDeploymentPolicyResponse
s@GetContinuousDeploymentPolicyResponse' {} Maybe Text
a -> GetContinuousDeploymentPolicyResponse
s {$sel:eTag:GetContinuousDeploymentPolicyResponse' :: Maybe Text
eTag = Maybe Text
a} :: GetContinuousDeploymentPolicyResponse)

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

instance
  Prelude.NFData
    GetContinuousDeploymentPolicyResponse
  where
  rnf :: GetContinuousDeploymentPolicyResponse -> ()
rnf GetContinuousDeploymentPolicyResponse' {Int
Maybe Text
Maybe ContinuousDeploymentPolicy
httpStatus :: Int
eTag :: Maybe Text
continuousDeploymentPolicy :: Maybe ContinuousDeploymentPolicy
$sel:httpStatus:GetContinuousDeploymentPolicyResponse' :: GetContinuousDeploymentPolicyResponse -> Int
$sel:eTag:GetContinuousDeploymentPolicyResponse' :: GetContinuousDeploymentPolicyResponse -> Maybe Text
$sel:continuousDeploymentPolicy:GetContinuousDeploymentPolicyResponse' :: GetContinuousDeploymentPolicyResponse
-> Maybe ContinuousDeploymentPolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContinuousDeploymentPolicy
continuousDeploymentPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus