{-# 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.CodePipeline.GetPipeline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the metadata, structure, stages, and actions of a pipeline. Can
-- be used to return the entire structure of a pipeline in JSON format,
-- which can then be modified and used to update the pipeline structure
-- with UpdatePipeline.
module Amazonka.CodePipeline.GetPipeline
  ( -- * Creating a Request
    GetPipeline (..),
    newGetPipeline,

    -- * Request Lenses
    getPipeline_version,
    getPipeline_name,

    -- * Destructuring the Response
    GetPipelineResponse (..),
    newGetPipelineResponse,

    -- * Response Lenses
    getPipelineResponse_metadata,
    getPipelineResponse_pipeline,
    getPipelineResponse_httpStatus,
  )
where

import Amazonka.CodePipeline.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

-- | Represents the input of a @GetPipeline@ action.
--
-- /See:/ 'newGetPipeline' smart constructor.
data GetPipeline = GetPipeline'
  { -- | The version number of the pipeline. If you do not specify a version,
    -- defaults to the current version.
    GetPipeline -> Maybe Natural
version :: Prelude.Maybe Prelude.Natural,
    -- | The name of the pipeline for which you want to get information. Pipeline
    -- names must be unique under an AWS user account.
    GetPipeline -> Text
name :: Prelude.Text
  }
  deriving (GetPipeline -> GetPipeline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPipeline -> GetPipeline -> Bool
$c/= :: GetPipeline -> GetPipeline -> Bool
== :: GetPipeline -> GetPipeline -> Bool
$c== :: GetPipeline -> GetPipeline -> Bool
Prelude.Eq, ReadPrec [GetPipeline]
ReadPrec GetPipeline
Int -> ReadS GetPipeline
ReadS [GetPipeline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPipeline]
$creadListPrec :: ReadPrec [GetPipeline]
readPrec :: ReadPrec GetPipeline
$creadPrec :: ReadPrec GetPipeline
readList :: ReadS [GetPipeline]
$creadList :: ReadS [GetPipeline]
readsPrec :: Int -> ReadS GetPipeline
$creadsPrec :: Int -> ReadS GetPipeline
Prelude.Read, Int -> GetPipeline -> ShowS
[GetPipeline] -> ShowS
GetPipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPipeline] -> ShowS
$cshowList :: [GetPipeline] -> ShowS
show :: GetPipeline -> String
$cshow :: GetPipeline -> String
showsPrec :: Int -> GetPipeline -> ShowS
$cshowsPrec :: Int -> GetPipeline -> ShowS
Prelude.Show, forall x. Rep GetPipeline x -> GetPipeline
forall x. GetPipeline -> Rep GetPipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPipeline x -> GetPipeline
$cfrom :: forall x. GetPipeline -> Rep GetPipeline x
Prelude.Generic)

-- |
-- Create a value of 'GetPipeline' 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:
--
-- 'version', 'getPipeline_version' - The version number of the pipeline. If you do not specify a version,
-- defaults to the current version.
--
-- 'name', 'getPipeline_name' - The name of the pipeline for which you want to get information. Pipeline
-- names must be unique under an AWS user account.
newGetPipeline ::
  -- | 'name'
  Prelude.Text ->
  GetPipeline
newGetPipeline :: Text -> GetPipeline
newGetPipeline Text
pName_ =
  GetPipeline'
    { $sel:version:GetPipeline' :: Maybe Natural
version = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetPipeline' :: Text
name = Text
pName_
    }

-- | The version number of the pipeline. If you do not specify a version,
-- defaults to the current version.
getPipeline_version :: Lens.Lens' GetPipeline (Prelude.Maybe Prelude.Natural)
getPipeline_version :: Lens' GetPipeline (Maybe Natural)
getPipeline_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipeline' {Maybe Natural
version :: Maybe Natural
$sel:version:GetPipeline' :: GetPipeline -> Maybe Natural
version} -> Maybe Natural
version) (\s :: GetPipeline
s@GetPipeline' {} Maybe Natural
a -> GetPipeline
s {$sel:version:GetPipeline' :: Maybe Natural
version = Maybe Natural
a} :: GetPipeline)

-- | The name of the pipeline for which you want to get information. Pipeline
-- names must be unique under an AWS user account.
getPipeline_name :: Lens.Lens' GetPipeline Prelude.Text
getPipeline_name :: Lens' GetPipeline Text
getPipeline_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipeline' {Text
name :: Text
$sel:name:GetPipeline' :: GetPipeline -> Text
name} -> Text
name) (\s :: GetPipeline
s@GetPipeline' {} Text
a -> GetPipeline
s {$sel:name:GetPipeline' :: Text
name = Text
a} :: GetPipeline)

instance Core.AWSRequest GetPipeline where
  type AWSResponse GetPipeline = GetPipelineResponse
  request :: (Service -> Service) -> GetPipeline -> Request GetPipeline
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 GetPipeline
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPipeline)))
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 PipelineMetadata
-> Maybe PipelineDeclaration -> Int -> GetPipelineResponse
GetPipelineResponse'
            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
"metadata")
            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
"pipeline")
            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 GetPipeline where
  hashWithSalt :: Int -> GetPipeline -> Int
hashWithSalt Int
_salt GetPipeline' {Maybe Natural
Text
name :: Text
version :: Maybe Natural
$sel:name:GetPipeline' :: GetPipeline -> Text
$sel:version:GetPipeline' :: GetPipeline -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
version
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders GetPipeline where
  toHeaders :: GetPipeline -> 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
"CodePipeline_20150709.GetPipeline" ::
                          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 GetPipeline where
  toJSON :: GetPipeline -> Value
toJSON GetPipeline' {Maybe Natural
Text
name :: Text
version :: Maybe Natural
$sel:name:GetPipeline' :: GetPipeline -> Text
$sel:version:GetPipeline' :: GetPipeline -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"version" 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 Natural
version,
            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 GetPipeline where
  toPath :: GetPipeline -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of a @GetPipeline@ action.
--
-- /See:/ 'newGetPipelineResponse' smart constructor.
data GetPipelineResponse = GetPipelineResponse'
  { -- | Represents the pipeline metadata information returned as part of the
    -- output of a @GetPipeline@ action.
    GetPipelineResponse -> Maybe PipelineMetadata
metadata :: Prelude.Maybe PipelineMetadata,
    -- | Represents the structure of actions and stages to be performed in the
    -- pipeline.
    GetPipelineResponse -> Maybe PipelineDeclaration
pipeline :: Prelude.Maybe PipelineDeclaration,
    -- | The response's http status code.
    GetPipelineResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPipelineResponse -> GetPipelineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPipelineResponse -> GetPipelineResponse -> Bool
$c/= :: GetPipelineResponse -> GetPipelineResponse -> Bool
== :: GetPipelineResponse -> GetPipelineResponse -> Bool
$c== :: GetPipelineResponse -> GetPipelineResponse -> Bool
Prelude.Eq, ReadPrec [GetPipelineResponse]
ReadPrec GetPipelineResponse
Int -> ReadS GetPipelineResponse
ReadS [GetPipelineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPipelineResponse]
$creadListPrec :: ReadPrec [GetPipelineResponse]
readPrec :: ReadPrec GetPipelineResponse
$creadPrec :: ReadPrec GetPipelineResponse
readList :: ReadS [GetPipelineResponse]
$creadList :: ReadS [GetPipelineResponse]
readsPrec :: Int -> ReadS GetPipelineResponse
$creadsPrec :: Int -> ReadS GetPipelineResponse
Prelude.Read, Int -> GetPipelineResponse -> ShowS
[GetPipelineResponse] -> ShowS
GetPipelineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPipelineResponse] -> ShowS
$cshowList :: [GetPipelineResponse] -> ShowS
show :: GetPipelineResponse -> String
$cshow :: GetPipelineResponse -> String
showsPrec :: Int -> GetPipelineResponse -> ShowS
$cshowsPrec :: Int -> GetPipelineResponse -> ShowS
Prelude.Show, forall x. Rep GetPipelineResponse x -> GetPipelineResponse
forall x. GetPipelineResponse -> Rep GetPipelineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPipelineResponse x -> GetPipelineResponse
$cfrom :: forall x. GetPipelineResponse -> Rep GetPipelineResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPipelineResponse' 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:
--
-- 'metadata', 'getPipelineResponse_metadata' - Represents the pipeline metadata information returned as part of the
-- output of a @GetPipeline@ action.
--
-- 'pipeline', 'getPipelineResponse_pipeline' - Represents the structure of actions and stages to be performed in the
-- pipeline.
--
-- 'httpStatus', 'getPipelineResponse_httpStatus' - The response's http status code.
newGetPipelineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPipelineResponse
newGetPipelineResponse :: Int -> GetPipelineResponse
newGetPipelineResponse Int
pHttpStatus_ =
  GetPipelineResponse'
    { $sel:metadata:GetPipelineResponse' :: Maybe PipelineMetadata
metadata = forall a. Maybe a
Prelude.Nothing,
      $sel:pipeline:GetPipelineResponse' :: Maybe PipelineDeclaration
pipeline = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPipelineResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Represents the pipeline metadata information returned as part of the
-- output of a @GetPipeline@ action.
getPipelineResponse_metadata :: Lens.Lens' GetPipelineResponse (Prelude.Maybe PipelineMetadata)
getPipelineResponse_metadata :: Lens' GetPipelineResponse (Maybe PipelineMetadata)
getPipelineResponse_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineResponse' {Maybe PipelineMetadata
metadata :: Maybe PipelineMetadata
$sel:metadata:GetPipelineResponse' :: GetPipelineResponse -> Maybe PipelineMetadata
metadata} -> Maybe PipelineMetadata
metadata) (\s :: GetPipelineResponse
s@GetPipelineResponse' {} Maybe PipelineMetadata
a -> GetPipelineResponse
s {$sel:metadata:GetPipelineResponse' :: Maybe PipelineMetadata
metadata = Maybe PipelineMetadata
a} :: GetPipelineResponse)

-- | Represents the structure of actions and stages to be performed in the
-- pipeline.
getPipelineResponse_pipeline :: Lens.Lens' GetPipelineResponse (Prelude.Maybe PipelineDeclaration)
getPipelineResponse_pipeline :: Lens' GetPipelineResponse (Maybe PipelineDeclaration)
getPipelineResponse_pipeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineResponse' {Maybe PipelineDeclaration
pipeline :: Maybe PipelineDeclaration
$sel:pipeline:GetPipelineResponse' :: GetPipelineResponse -> Maybe PipelineDeclaration
pipeline} -> Maybe PipelineDeclaration
pipeline) (\s :: GetPipelineResponse
s@GetPipelineResponse' {} Maybe PipelineDeclaration
a -> GetPipelineResponse
s {$sel:pipeline:GetPipelineResponse' :: Maybe PipelineDeclaration
pipeline = Maybe PipelineDeclaration
a} :: GetPipelineResponse)

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

instance Prelude.NFData GetPipelineResponse where
  rnf :: GetPipelineResponse -> ()
rnf GetPipelineResponse' {Int
Maybe PipelineMetadata
Maybe PipelineDeclaration
httpStatus :: Int
pipeline :: Maybe PipelineDeclaration
metadata :: Maybe PipelineMetadata
$sel:httpStatus:GetPipelineResponse' :: GetPipelineResponse -> Int
$sel:pipeline:GetPipelineResponse' :: GetPipelineResponse -> Maybe PipelineDeclaration
$sel:metadata:GetPipelineResponse' :: GetPipelineResponse -> Maybe PipelineMetadata
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PipelineMetadata
metadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipelineDeclaration
pipeline
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus