{-# 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.CodeDeploy.GetApplication
-- 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 information about an application.
module Amazonka.CodeDeploy.GetApplication
  ( -- * Creating a Request
    GetApplication (..),
    newGetApplication,

    -- * Request Lenses
    getApplication_applicationName,

    -- * Destructuring the Response
    GetApplicationResponse (..),
    newGetApplicationResponse,

    -- * Response Lenses
    getApplicationResponse_application,
    getApplicationResponse_httpStatus,
  )
where

import Amazonka.CodeDeploy.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 @GetApplication@ operation.
--
-- /See:/ 'newGetApplication' smart constructor.
data GetApplication = GetApplication'
  { -- | The name of an CodeDeploy application associated with the IAM user or
    -- Amazon Web Services account.
    GetApplication -> Text
applicationName :: Prelude.Text
  }
  deriving (GetApplication -> GetApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplication -> GetApplication -> Bool
$c/= :: GetApplication -> GetApplication -> Bool
== :: GetApplication -> GetApplication -> Bool
$c== :: GetApplication -> GetApplication -> Bool
Prelude.Eq, ReadPrec [GetApplication]
ReadPrec GetApplication
Int -> ReadS GetApplication
ReadS [GetApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplication]
$creadListPrec :: ReadPrec [GetApplication]
readPrec :: ReadPrec GetApplication
$creadPrec :: ReadPrec GetApplication
readList :: ReadS [GetApplication]
$creadList :: ReadS [GetApplication]
readsPrec :: Int -> ReadS GetApplication
$creadsPrec :: Int -> ReadS GetApplication
Prelude.Read, Int -> GetApplication -> ShowS
[GetApplication] -> ShowS
GetApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplication] -> ShowS
$cshowList :: [GetApplication] -> ShowS
show :: GetApplication -> String
$cshow :: GetApplication -> String
showsPrec :: Int -> GetApplication -> ShowS
$cshowsPrec :: Int -> GetApplication -> ShowS
Prelude.Show, forall x. Rep GetApplication x -> GetApplication
forall x. GetApplication -> Rep GetApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplication x -> GetApplication
$cfrom :: forall x. GetApplication -> Rep GetApplication x
Prelude.Generic)

-- |
-- Create a value of 'GetApplication' 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:
--
-- 'applicationName', 'getApplication_applicationName' - The name of an CodeDeploy application associated with the IAM user or
-- Amazon Web Services account.
newGetApplication ::
  -- | 'applicationName'
  Prelude.Text ->
  GetApplication
newGetApplication :: Text -> GetApplication
newGetApplication Text
pApplicationName_ =
  GetApplication'
    { $sel:applicationName:GetApplication' :: Text
applicationName =
        Text
pApplicationName_
    }

-- | The name of an CodeDeploy application associated with the IAM user or
-- Amazon Web Services account.
getApplication_applicationName :: Lens.Lens' GetApplication Prelude.Text
getApplication_applicationName :: Lens' GetApplication Text
getApplication_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplication' {Text
applicationName :: Text
$sel:applicationName:GetApplication' :: GetApplication -> Text
applicationName} -> Text
applicationName) (\s :: GetApplication
s@GetApplication' {} Text
a -> GetApplication
s {$sel:applicationName:GetApplication' :: Text
applicationName = Text
a} :: GetApplication)

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

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

instance Data.ToHeaders GetApplication where
  toHeaders :: GetApplication -> 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
"CodeDeploy_20141006.GetApplication" ::
                          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 GetApplication where
  toJSON :: GetApplication -> Value
toJSON GetApplication' {Text
applicationName :: Text
$sel:applicationName:GetApplication' :: GetApplication -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName)
          ]
      )

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

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

-- | Represents the output of a @GetApplication@ operation.
--
-- /See:/ 'newGetApplicationResponse' smart constructor.
data GetApplicationResponse = GetApplicationResponse'
  { -- | Information about the application.
    GetApplicationResponse -> Maybe ApplicationInfo
application :: Prelude.Maybe ApplicationInfo,
    -- | The response's http status code.
    GetApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetApplicationResponse -> GetApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
== :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c== :: GetApplicationResponse -> GetApplicationResponse -> Bool
Prelude.Eq, ReadPrec [GetApplicationResponse]
ReadPrec GetApplicationResponse
Int -> ReadS GetApplicationResponse
ReadS [GetApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationResponse]
$creadListPrec :: ReadPrec [GetApplicationResponse]
readPrec :: ReadPrec GetApplicationResponse
$creadPrec :: ReadPrec GetApplicationResponse
readList :: ReadS [GetApplicationResponse]
$creadList :: ReadS [GetApplicationResponse]
readsPrec :: Int -> ReadS GetApplicationResponse
$creadsPrec :: Int -> ReadS GetApplicationResponse
Prelude.Read, Int -> GetApplicationResponse -> ShowS
[GetApplicationResponse] -> ShowS
GetApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationResponse] -> ShowS
$cshowList :: [GetApplicationResponse] -> ShowS
show :: GetApplicationResponse -> String
$cshow :: GetApplicationResponse -> String
showsPrec :: Int -> GetApplicationResponse -> ShowS
$cshowsPrec :: Int -> GetApplicationResponse -> ShowS
Prelude.Show, forall x. Rep GetApplicationResponse x -> GetApplicationResponse
forall x. GetApplicationResponse -> Rep GetApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplicationResponse x -> GetApplicationResponse
$cfrom :: forall x. GetApplicationResponse -> Rep GetApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationResponse' 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:
--
-- 'application', 'getApplicationResponse_application' - Information about the application.
--
-- 'httpStatus', 'getApplicationResponse_httpStatus' - The response's http status code.
newGetApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetApplicationResponse
newGetApplicationResponse :: Int -> GetApplicationResponse
newGetApplicationResponse Int
pHttpStatus_ =
  GetApplicationResponse'
    { $sel:application:GetApplicationResponse' :: Maybe ApplicationInfo
application =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the application.
getApplicationResponse_application :: Lens.Lens' GetApplicationResponse (Prelude.Maybe ApplicationInfo)
getApplicationResponse_application :: Lens' GetApplicationResponse (Maybe ApplicationInfo)
getApplicationResponse_application = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe ApplicationInfo
application :: Maybe ApplicationInfo
$sel:application:GetApplicationResponse' :: GetApplicationResponse -> Maybe ApplicationInfo
application} -> Maybe ApplicationInfo
application) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe ApplicationInfo
a -> GetApplicationResponse
s {$sel:application:GetApplicationResponse' :: Maybe ApplicationInfo
application = Maybe ApplicationInfo
a} :: GetApplicationResponse)

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

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