{-# 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.RegisterApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Register an SAP application with AWS Systems Manager for SAP. You must
-- meet the following requirements before registering.
--
-- The SAP application you want to register with AWS Systems Manager for
-- SAP is running on Amazon EC2.
--
-- AWS Systems Manager Agent must be setup on an Amazon EC2 instance along
-- with the required IAM permissions.
--
-- Amazon EC2 instance(s) must have access to the secrets created in AWS
-- Secrets Manager to manage SAP applications and components.
module Amazonka.SSMSAP.RegisterApplication
  ( -- * Creating a Request
    RegisterApplication (..),
    newRegisterApplication,

    -- * Request Lenses
    registerApplication_sapInstanceNumber,
    registerApplication_sid,
    registerApplication_tags,
    registerApplication_applicationId,
    registerApplication_applicationType,
    registerApplication_instances,
    registerApplication_credentials,

    -- * Destructuring the Response
    RegisterApplicationResponse (..),
    newRegisterApplicationResponse,

    -- * Response Lenses
    registerApplicationResponse_application,
    registerApplicationResponse_operationId,
    registerApplicationResponse_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:/ 'newRegisterApplication' smart constructor.
data RegisterApplication = RegisterApplication'
  { RegisterApplication -> Maybe Text
sapInstanceNumber :: Prelude.Maybe Prelude.Text,
    RegisterApplication -> Maybe Text
sid :: Prelude.Maybe Prelude.Text,
    RegisterApplication -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    RegisterApplication -> Text
applicationId :: Prelude.Text,
    RegisterApplication -> ApplicationType
applicationType :: ApplicationType,
    RegisterApplication -> NonEmpty Text
instances :: Prelude.NonEmpty Prelude.Text,
    RegisterApplication -> NonEmpty ApplicationCredential
credentials :: Prelude.NonEmpty ApplicationCredential
  }
  deriving (RegisterApplication -> RegisterApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterApplication -> RegisterApplication -> Bool
$c/= :: RegisterApplication -> RegisterApplication -> Bool
== :: RegisterApplication -> RegisterApplication -> Bool
$c== :: RegisterApplication -> RegisterApplication -> Bool
Prelude.Eq, Int -> RegisterApplication -> ShowS
[RegisterApplication] -> ShowS
RegisterApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterApplication] -> ShowS
$cshowList :: [RegisterApplication] -> ShowS
show :: RegisterApplication -> String
$cshow :: RegisterApplication -> String
showsPrec :: Int -> RegisterApplication -> ShowS
$cshowsPrec :: Int -> RegisterApplication -> ShowS
Prelude.Show, forall x. Rep RegisterApplication x -> RegisterApplication
forall x. RegisterApplication -> Rep RegisterApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterApplication x -> RegisterApplication
$cfrom :: forall x. RegisterApplication -> Rep RegisterApplication x
Prelude.Generic)

-- |
-- Create a value of 'RegisterApplication' 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:
--
-- 'sapInstanceNumber', 'registerApplication_sapInstanceNumber' -
--
-- 'sid', 'registerApplication_sid' -
--
-- 'tags', 'registerApplication_tags' -
--
-- 'applicationId', 'registerApplication_applicationId' -
--
-- 'applicationType', 'registerApplication_applicationType' -
--
-- 'instances', 'registerApplication_instances' -
--
-- 'credentials', 'registerApplication_credentials' -
newRegisterApplication ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'applicationType'
  ApplicationType ->
  -- | 'instances'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'credentials'
  Prelude.NonEmpty ApplicationCredential ->
  RegisterApplication
newRegisterApplication :: Text
-> ApplicationType
-> NonEmpty Text
-> NonEmpty ApplicationCredential
-> RegisterApplication
newRegisterApplication
  Text
pApplicationId_
  ApplicationType
pApplicationType_
  NonEmpty Text
pInstances_
  NonEmpty ApplicationCredential
pCredentials_ =
    RegisterApplication'
      { $sel:sapInstanceNumber:RegisterApplication' :: Maybe Text
sapInstanceNumber =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sid:RegisterApplication' :: Maybe Text
sid = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:RegisterApplication' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:RegisterApplication' :: Text
applicationId = Text
pApplicationId_,
        $sel:applicationType:RegisterApplication' :: ApplicationType
applicationType = ApplicationType
pApplicationType_,
        $sel:instances:RegisterApplication' :: NonEmpty Text
instances = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pInstances_,
        $sel:credentials:RegisterApplication' :: NonEmpty ApplicationCredential
credentials = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ApplicationCredential
pCredentials_
      }

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

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

registerApplication_tags :: Lens.Lens' RegisterApplication (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
registerApplication_tags :: Lens' RegisterApplication (Maybe (HashMap Text Text))
registerApplication_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterApplication' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:RegisterApplication' :: RegisterApplication -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: RegisterApplication
s@RegisterApplication' {} Maybe (HashMap Text Text)
a -> RegisterApplication
s {$sel:tags:RegisterApplication' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: RegisterApplication) 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

registerApplication_applicationId :: Lens.Lens' RegisterApplication Prelude.Text
registerApplication_applicationId :: Lens' RegisterApplication Text
registerApplication_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterApplication' {Text
applicationId :: Text
$sel:applicationId:RegisterApplication' :: RegisterApplication -> Text
applicationId} -> Text
applicationId) (\s :: RegisterApplication
s@RegisterApplication' {} Text
a -> RegisterApplication
s {$sel:applicationId:RegisterApplication' :: Text
applicationId = Text
a} :: RegisterApplication)

registerApplication_applicationType :: Lens.Lens' RegisterApplication ApplicationType
registerApplication_applicationType :: Lens' RegisterApplication ApplicationType
registerApplication_applicationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterApplication' {ApplicationType
applicationType :: ApplicationType
$sel:applicationType:RegisterApplication' :: RegisterApplication -> ApplicationType
applicationType} -> ApplicationType
applicationType) (\s :: RegisterApplication
s@RegisterApplication' {} ApplicationType
a -> RegisterApplication
s {$sel:applicationType:RegisterApplication' :: ApplicationType
applicationType = ApplicationType
a} :: RegisterApplication)

registerApplication_instances :: Lens.Lens' RegisterApplication (Prelude.NonEmpty Prelude.Text)
registerApplication_instances :: Lens' RegisterApplication (NonEmpty Text)
registerApplication_instances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterApplication' {NonEmpty Text
instances :: NonEmpty Text
$sel:instances:RegisterApplication' :: RegisterApplication -> NonEmpty Text
instances} -> NonEmpty Text
instances) (\s :: RegisterApplication
s@RegisterApplication' {} NonEmpty Text
a -> RegisterApplication
s {$sel:instances:RegisterApplication' :: NonEmpty Text
instances = NonEmpty Text
a} :: RegisterApplication) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

registerApplication_credentials :: Lens.Lens' RegisterApplication (Prelude.NonEmpty ApplicationCredential)
registerApplication_credentials :: Lens' RegisterApplication (NonEmpty ApplicationCredential)
registerApplication_credentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterApplication' {NonEmpty ApplicationCredential
credentials :: NonEmpty ApplicationCredential
$sel:credentials:RegisterApplication' :: RegisterApplication -> NonEmpty ApplicationCredential
credentials} -> NonEmpty ApplicationCredential
credentials) (\s :: RegisterApplication
s@RegisterApplication' {} NonEmpty ApplicationCredential
a -> RegisterApplication
s {$sel:credentials:RegisterApplication' :: NonEmpty ApplicationCredential
credentials = NonEmpty ApplicationCredential
a} :: RegisterApplication) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest RegisterApplication where
  type
    AWSResponse RegisterApplication =
      RegisterApplicationResponse
  request :: (Service -> Service)
-> RegisterApplication -> Request RegisterApplication
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 RegisterApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterApplication)))
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 Text -> Int -> RegisterApplicationResponse
RegisterApplicationResponse'
            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
"OperationId")
            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 RegisterApplication where
  hashWithSalt :: Int -> RegisterApplication -> Int
hashWithSalt Int
_salt RegisterApplication' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
NonEmpty ApplicationCredential
Text
ApplicationType
credentials :: NonEmpty ApplicationCredential
instances :: NonEmpty Text
applicationType :: ApplicationType
applicationId :: Text
tags :: Maybe (HashMap Text Text)
sid :: Maybe Text
sapInstanceNumber :: Maybe Text
$sel:credentials:RegisterApplication' :: RegisterApplication -> NonEmpty ApplicationCredential
$sel:instances:RegisterApplication' :: RegisterApplication -> NonEmpty Text
$sel:applicationType:RegisterApplication' :: RegisterApplication -> ApplicationType
$sel:applicationId:RegisterApplication' :: RegisterApplication -> Text
$sel:tags:RegisterApplication' :: RegisterApplication -> Maybe (HashMap Text Text)
$sel:sid:RegisterApplication' :: RegisterApplication -> Maybe Text
$sel:sapInstanceNumber:RegisterApplication' :: RegisterApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sapInstanceNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApplicationType
applicationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
instances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ApplicationCredential
credentials

instance Prelude.NFData RegisterApplication where
  rnf :: RegisterApplication -> ()
rnf RegisterApplication' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
NonEmpty ApplicationCredential
Text
ApplicationType
credentials :: NonEmpty ApplicationCredential
instances :: NonEmpty Text
applicationType :: ApplicationType
applicationId :: Text
tags :: Maybe (HashMap Text Text)
sid :: Maybe Text
sapInstanceNumber :: Maybe Text
$sel:credentials:RegisterApplication' :: RegisterApplication -> NonEmpty ApplicationCredential
$sel:instances:RegisterApplication' :: RegisterApplication -> NonEmpty Text
$sel:applicationType:RegisterApplication' :: RegisterApplication -> ApplicationType
$sel:applicationId:RegisterApplication' :: RegisterApplication -> Text
$sel:tags:RegisterApplication' :: RegisterApplication -> Maybe (HashMap Text Text)
$sel:sid:RegisterApplication' :: RegisterApplication -> Maybe Text
$sel:sapInstanceNumber:RegisterApplication' :: RegisterApplication -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sapInstanceNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sid
      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 Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApplicationType
applicationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
instances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ApplicationCredential
credentials

instance Data.ToHeaders RegisterApplication where
  toHeaders :: RegisterApplication -> 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 RegisterApplication where
  toJSON :: RegisterApplication -> Value
toJSON RegisterApplication' {Maybe Text
Maybe (HashMap Text Text)
NonEmpty Text
NonEmpty ApplicationCredential
Text
ApplicationType
credentials :: NonEmpty ApplicationCredential
instances :: NonEmpty Text
applicationType :: ApplicationType
applicationId :: Text
tags :: Maybe (HashMap Text Text)
sid :: Maybe Text
sapInstanceNumber :: Maybe Text
$sel:credentials:RegisterApplication' :: RegisterApplication -> NonEmpty ApplicationCredential
$sel:instances:RegisterApplication' :: RegisterApplication -> NonEmpty Text
$sel:applicationType:RegisterApplication' :: RegisterApplication -> ApplicationType
$sel:applicationId:RegisterApplication' :: RegisterApplication -> Text
$sel:tags:RegisterApplication' :: RegisterApplication -> Maybe (HashMap Text Text)
$sel:sid:RegisterApplication' :: RegisterApplication -> Maybe Text
$sel:sapInstanceNumber:RegisterApplication' :: RegisterApplication -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SapInstanceNumber" 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
sapInstanceNumber,
            (Key
"Sid" 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
sid,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"ApplicationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ApplicationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ApplicationType
applicationType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Instances" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
instances),
            forall a. a -> Maybe a
Prelude.Just (Key
"Credentials" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ApplicationCredential
credentials)
          ]
      )

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

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

-- | /See:/ 'newRegisterApplicationResponse' smart constructor.
data RegisterApplicationResponse = RegisterApplicationResponse'
  { RegisterApplicationResponse -> Maybe Application
application :: Prelude.Maybe Application,
    RegisterApplicationResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterApplicationResponse -> RegisterApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterApplicationResponse -> RegisterApplicationResponse -> Bool
$c/= :: RegisterApplicationResponse -> RegisterApplicationResponse -> Bool
== :: RegisterApplicationResponse -> RegisterApplicationResponse -> Bool
$c== :: RegisterApplicationResponse -> RegisterApplicationResponse -> Bool
Prelude.Eq, ReadPrec [RegisterApplicationResponse]
ReadPrec RegisterApplicationResponse
Int -> ReadS RegisterApplicationResponse
ReadS [RegisterApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterApplicationResponse]
$creadListPrec :: ReadPrec [RegisterApplicationResponse]
readPrec :: ReadPrec RegisterApplicationResponse
$creadPrec :: ReadPrec RegisterApplicationResponse
readList :: ReadS [RegisterApplicationResponse]
$creadList :: ReadS [RegisterApplicationResponse]
readsPrec :: Int -> ReadS RegisterApplicationResponse
$creadsPrec :: Int -> ReadS RegisterApplicationResponse
Prelude.Read, Int -> RegisterApplicationResponse -> ShowS
[RegisterApplicationResponse] -> ShowS
RegisterApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterApplicationResponse] -> ShowS
$cshowList :: [RegisterApplicationResponse] -> ShowS
show :: RegisterApplicationResponse -> String
$cshow :: RegisterApplicationResponse -> String
showsPrec :: Int -> RegisterApplicationResponse -> ShowS
$cshowsPrec :: Int -> RegisterApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterApplicationResponse x -> RegisterApplicationResponse
forall x.
RegisterApplicationResponse -> Rep RegisterApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterApplicationResponse x -> RegisterApplicationResponse
$cfrom :: forall x.
RegisterApplicationResponse -> Rep RegisterApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterApplicationResponse' 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', 'registerApplicationResponse_application' -
--
-- 'operationId', 'registerApplicationResponse_operationId' -
--
-- 'httpStatus', 'registerApplicationResponse_httpStatus' - The response's http status code.
newRegisterApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterApplicationResponse
newRegisterApplicationResponse :: Int -> RegisterApplicationResponse
newRegisterApplicationResponse Int
pHttpStatus_ =
  RegisterApplicationResponse'
    { $sel:application:RegisterApplicationResponse' :: Maybe Application
application =
        forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:RegisterApplicationResponse' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

instance Prelude.NFData RegisterApplicationResponse where
  rnf :: RegisterApplicationResponse -> ()
rnf RegisterApplicationResponse' {Int
Maybe Text
Maybe Application
httpStatus :: Int
operationId :: Maybe Text
application :: Maybe Application
$sel:httpStatus:RegisterApplicationResponse' :: RegisterApplicationResponse -> Int
$sel:operationId:RegisterApplicationResponse' :: RegisterApplicationResponse -> Maybe Text
$sel:application:RegisterApplicationResponse' :: RegisterApplicationResponse -> 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 Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus