{-# 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.SSMSAP.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 an application registered with AWS Systems Manager for SAP. It also
-- returns the components of the application.
module Amazonka.SSMSAP.GetApplication
  ( -- * Creating a Request
    GetApplication (..),
    newGetApplication,

    -- * Request Lenses
    getApplication_applicationArn,
    getApplication_applicationId,

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

    -- * Response Lenses
    getApplicationResponse_application,
    getApplicationResponse_tags,
    getApplicationResponse_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.SSMSAP.Types

-- | /See:/ 'newGetApplication' smart constructor.
data GetApplication = GetApplication'
  { GetApplication -> Maybe Text
applicationArn :: Prelude.Maybe Prelude.Text,
    GetApplication -> Maybe Text
applicationId :: Prelude.Maybe 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:
--
-- 'applicationArn', 'getApplication_applicationArn' -
--
-- 'applicationId', 'getApplication_applicationId' -
newGetApplication ::
  GetApplication
newGetApplication :: GetApplication
newGetApplication =
  GetApplication'
    { $sel:applicationArn:GetApplication' :: Maybe Text
applicationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:GetApplication' :: Maybe Text
applicationId = forall a. Maybe a
Prelude.Nothing
    }

getApplication_applicationArn :: Lens.Lens' GetApplication (Prelude.Maybe Prelude.Text)
getApplication_applicationArn :: Lens' GetApplication (Maybe Text)
getApplication_applicationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplication' {Maybe Text
applicationArn :: Maybe Text
$sel:applicationArn:GetApplication' :: GetApplication -> Maybe Text
applicationArn} -> Maybe Text
applicationArn) (\s :: GetApplication
s@GetApplication' {} Maybe Text
a -> GetApplication
s {$sel:applicationArn:GetApplication' :: Maybe Text
applicationArn = Maybe Text
a} :: GetApplication)

getApplication_applicationId :: Lens.Lens' GetApplication (Prelude.Maybe Prelude.Text)
getApplication_applicationId :: Lens' GetApplication (Maybe Text)
getApplication_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplication' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: GetApplication
s@GetApplication' {} Maybe Text
a -> GetApplication
s {$sel:applicationId:GetApplication' :: Maybe Text
applicationId = Maybe 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 Application
-> Maybe (HashMap Text Text) -> 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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' {Maybe Text
applicationId :: Maybe Text
applicationArn :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Maybe Text
$sel:applicationArn:GetApplication' :: GetApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationId

instance Prelude.NFData GetApplication where
  rnf :: GetApplication -> ()
rnf GetApplication' {Maybe Text
applicationId :: Maybe Text
applicationArn :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Maybe Text
$sel:applicationArn:GetApplication' :: GetApplication -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId

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
"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' {Maybe Text
applicationId :: Maybe Text
applicationArn :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Maybe Text
$sel:applicationArn:GetApplication' :: GetApplication -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApplicationArn" 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 Text
applicationArn,
            (Key
"ApplicationId" 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 Text
applicationId
          ]
      )

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

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

-- | /See:/ 'newGetApplicationResponse' smart constructor.
data GetApplicationResponse = GetApplicationResponse'
  { GetApplicationResponse -> Maybe Application
application :: Prelude.Maybe Application,
    GetApplicationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | 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' -
--
-- 'tags', 'getApplicationResponse_tags' -
--
-- '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 Application
application =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetApplicationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

getApplicationResponse_tags :: Lens.Lens' GetApplicationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getApplicationResponse_tags :: Lens' GetApplicationResponse (Maybe (HashMap Text Text))
getApplicationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetApplicationResponse' :: GetApplicationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe (HashMap Text Text)
a -> GetApplicationResponse
s {$sel:tags:GetApplicationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetApplicationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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 (HashMap Text Text)
Maybe Application
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
application :: Maybe Application
$sel:httpStatus:GetApplicationResponse' :: GetApplicationResponse -> Int
$sel:tags:GetApplicationResponse' :: GetApplicationResponse -> Maybe (HashMap Text Text)
$sel:application:GetApplicationResponse' :: GetApplicationResponse -> Maybe Application
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Application
application
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus