{-# 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.Proton.CreateService
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create an Proton service. An Proton service is an instantiation of a
-- service template and often includes several service instances and
-- pipeline. For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-services.html Services>
-- in the /Proton User Guide/.
module Amazonka.Proton.CreateService
  ( -- * Creating a Request
    CreateService (..),
    newCreateService,

    -- * Request Lenses
    createService_branchName,
    createService_description,
    createService_repositoryConnectionArn,
    createService_repositoryId,
    createService_tags,
    createService_templateMinorVersion,
    createService_name,
    createService_spec,
    createService_templateMajorVersion,
    createService_templateName,

    -- * Destructuring the Response
    CreateServiceResponse (..),
    newCreateServiceResponse,

    -- * Response Lenses
    createServiceResponse_httpStatus,
    createServiceResponse_service,
  )
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 Amazonka.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateService' smart constructor.
data CreateService = CreateService'
  { -- | The name of the code repository branch that holds the code that\'s
    -- deployed in Proton. /Don\'t/ include this parameter if your service
    -- template /doesn\'t/ include a service pipeline.
    CreateService -> Maybe Text
branchName :: Prelude.Maybe Prelude.Text,
    -- | A description of the Proton service.
    CreateService -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Resource Name (ARN) of the repository connection. For more
    -- information, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/setting-up-for-service.html#setting-up-vcontrol Setting up an AWS CodeStar connection>
    -- in the /Proton User Guide/. /Don\'t/ include this parameter if your
    -- service template /doesn\'t/ include a service pipeline.
    CreateService -> Maybe Text
repositoryConnectionArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the code repository. /Don\'t/ include this parameter if your
    -- service template /doesn\'t/ include a service pipeline.
    CreateService -> Maybe Text
repositoryId :: Prelude.Maybe Prelude.Text,
    -- | An optional list of metadata items that you can associate with the
    -- Proton service. A tag is a key-value pair.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
    -- in the /Proton User Guide/.
    CreateService -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The minor version of the service template that was used to create the
    -- service.
    CreateService -> Maybe Text
templateMinorVersion :: Prelude.Maybe Prelude.Text,
    -- | The service name.
    CreateService -> Text
name :: Prelude.Text,
    -- | A link to a spec file that provides inputs as defined in the service
    -- template bundle schema file. The spec file is in YAML format. /Don’t/
    -- include pipeline inputs in the spec if your service template /doesn’t/
    -- include a service pipeline. For more information, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/ag-create-svc.html Create a service>
    -- in the /Proton User Guide/.
    CreateService -> Sensitive Text
spec :: Data.Sensitive Prelude.Text,
    -- | The major version of the service template that was used to create the
    -- service.
    CreateService -> Text
templateMajorVersion :: Prelude.Text,
    -- | The name of the service template that\'s used to create the service.
    CreateService -> Text
templateName :: Prelude.Text
  }
  deriving (CreateService -> CreateService -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateService -> CreateService -> Bool
$c/= :: CreateService -> CreateService -> Bool
== :: CreateService -> CreateService -> Bool
$c== :: CreateService -> CreateService -> Bool
Prelude.Eq, Int -> CreateService -> ShowS
[CreateService] -> ShowS
CreateService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateService] -> ShowS
$cshowList :: [CreateService] -> ShowS
show :: CreateService -> String
$cshow :: CreateService -> String
showsPrec :: Int -> CreateService -> ShowS
$cshowsPrec :: Int -> CreateService -> ShowS
Prelude.Show, forall x. Rep CreateService x -> CreateService
forall x. CreateService -> Rep CreateService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateService x -> CreateService
$cfrom :: forall x. CreateService -> Rep CreateService x
Prelude.Generic)

-- |
-- Create a value of 'CreateService' 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:
--
-- 'branchName', 'createService_branchName' - The name of the code repository branch that holds the code that\'s
-- deployed in Proton. /Don\'t/ include this parameter if your service
-- template /doesn\'t/ include a service pipeline.
--
-- 'description', 'createService_description' - A description of the Proton service.
--
-- 'repositoryConnectionArn', 'createService_repositoryConnectionArn' - The Amazon Resource Name (ARN) of the repository connection. For more
-- information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/setting-up-for-service.html#setting-up-vcontrol Setting up an AWS CodeStar connection>
-- in the /Proton User Guide/. /Don\'t/ include this parameter if your
-- service template /doesn\'t/ include a service pipeline.
--
-- 'repositoryId', 'createService_repositoryId' - The ID of the code repository. /Don\'t/ include this parameter if your
-- service template /doesn\'t/ include a service pipeline.
--
-- 'tags', 'createService_tags' - An optional list of metadata items that you can associate with the
-- Proton service. A tag is a key-value pair.
--
-- For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
-- in the /Proton User Guide/.
--
-- 'templateMinorVersion', 'createService_templateMinorVersion' - The minor version of the service template that was used to create the
-- service.
--
-- 'name', 'createService_name' - The service name.
--
-- 'spec', 'createService_spec' - A link to a spec file that provides inputs as defined in the service
-- template bundle schema file. The spec file is in YAML format. /Don’t/
-- include pipeline inputs in the spec if your service template /doesn’t/
-- include a service pipeline. For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-create-svc.html Create a service>
-- in the /Proton User Guide/.
--
-- 'templateMajorVersion', 'createService_templateMajorVersion' - The major version of the service template that was used to create the
-- service.
--
-- 'templateName', 'createService_templateName' - The name of the service template that\'s used to create the service.
newCreateService ::
  -- | 'name'
  Prelude.Text ->
  -- | 'spec'
  Prelude.Text ->
  -- | 'templateMajorVersion'
  Prelude.Text ->
  -- | 'templateName'
  Prelude.Text ->
  CreateService
newCreateService :: Text -> Text -> Text -> Text -> CreateService
newCreateService
  Text
pName_
  Text
pSpec_
  Text
pTemplateMajorVersion_
  Text
pTemplateName_ =
    CreateService'
      { $sel:branchName:CreateService' :: Maybe Text
branchName = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateService' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryConnectionArn:CreateService' :: Maybe Text
repositoryConnectionArn = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryId:CreateService' :: Maybe Text
repositoryId = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateService' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:templateMinorVersion:CreateService' :: Maybe Text
templateMinorVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateService' :: Text
name = Text
pName_,
        $sel:spec:CreateService' :: Sensitive Text
spec = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pSpec_,
        $sel:templateMajorVersion:CreateService' :: Text
templateMajorVersion = Text
pTemplateMajorVersion_,
        $sel:templateName:CreateService' :: Text
templateName = Text
pTemplateName_
      }

-- | The name of the code repository branch that holds the code that\'s
-- deployed in Proton. /Don\'t/ include this parameter if your service
-- template /doesn\'t/ include a service pipeline.
createService_branchName :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_branchName :: Lens' CreateService (Maybe Text)
createService_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
branchName :: Maybe Text
$sel:branchName:CreateService' :: CreateService -> Maybe Text
branchName} -> Maybe Text
branchName) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:branchName:CreateService' :: Maybe Text
branchName = Maybe Text
a} :: CreateService)

-- | A description of the Proton service.
createService_description :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_description :: Lens' CreateService (Maybe Text)
createService_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateService' :: CreateService -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateService
s@CreateService' {} Maybe (Sensitive Text)
a -> CreateService
s {$sel:description:CreateService' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateService) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Resource Name (ARN) of the repository connection. For more
-- information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/setting-up-for-service.html#setting-up-vcontrol Setting up an AWS CodeStar connection>
-- in the /Proton User Guide/. /Don\'t/ include this parameter if your
-- service template /doesn\'t/ include a service pipeline.
createService_repositoryConnectionArn :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_repositoryConnectionArn :: Lens' CreateService (Maybe Text)
createService_repositoryConnectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
repositoryConnectionArn :: Maybe Text
$sel:repositoryConnectionArn:CreateService' :: CreateService -> Maybe Text
repositoryConnectionArn} -> Maybe Text
repositoryConnectionArn) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:repositoryConnectionArn:CreateService' :: Maybe Text
repositoryConnectionArn = Maybe Text
a} :: CreateService)

-- | The ID of the code repository. /Don\'t/ include this parameter if your
-- service template /doesn\'t/ include a service pipeline.
createService_repositoryId :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_repositoryId :: Lens' CreateService (Maybe Text)
createService_repositoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
repositoryId :: Maybe Text
$sel:repositoryId:CreateService' :: CreateService -> Maybe Text
repositoryId} -> Maybe Text
repositoryId) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:repositoryId:CreateService' :: Maybe Text
repositoryId = Maybe Text
a} :: CreateService)

-- | An optional list of metadata items that you can associate with the
-- Proton service. A tag is a key-value pair.
--
-- For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
-- in the /Proton User Guide/.
createService_tags :: Lens.Lens' CreateService (Prelude.Maybe [Tag])
createService_tags :: Lens' CreateService (Maybe [Tag])
createService_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateService
s@CreateService' {} Maybe [Tag]
a -> CreateService
s {$sel:tags:CreateService' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateService) 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 minor version of the service template that was used to create the
-- service.
createService_templateMinorVersion :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_templateMinorVersion :: Lens' CreateService (Maybe Text)
createService_templateMinorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
templateMinorVersion :: Maybe Text
$sel:templateMinorVersion:CreateService' :: CreateService -> Maybe Text
templateMinorVersion} -> Maybe Text
templateMinorVersion) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:templateMinorVersion:CreateService' :: Maybe Text
templateMinorVersion = Maybe Text
a} :: CreateService)

-- | The service name.
createService_name :: Lens.Lens' CreateService Prelude.Text
createService_name :: Lens' CreateService Text
createService_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Text
name :: Text
$sel:name:CreateService' :: CreateService -> Text
name} -> Text
name) (\s :: CreateService
s@CreateService' {} Text
a -> CreateService
s {$sel:name:CreateService' :: Text
name = Text
a} :: CreateService)

-- | A link to a spec file that provides inputs as defined in the service
-- template bundle schema file. The spec file is in YAML format. /Don’t/
-- include pipeline inputs in the spec if your service template /doesn’t/
-- include a service pipeline. For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-create-svc.html Create a service>
-- in the /Proton User Guide/.
createService_spec :: Lens.Lens' CreateService Prelude.Text
createService_spec :: Lens' CreateService Text
createService_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Sensitive Text
spec :: Sensitive Text
$sel:spec:CreateService' :: CreateService -> Sensitive Text
spec} -> Sensitive Text
spec) (\s :: CreateService
s@CreateService' {} Sensitive Text
a -> CreateService
s {$sel:spec:CreateService' :: Sensitive Text
spec = Sensitive Text
a} :: CreateService) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The major version of the service template that was used to create the
-- service.
createService_templateMajorVersion :: Lens.Lens' CreateService Prelude.Text
createService_templateMajorVersion :: Lens' CreateService Text
createService_templateMajorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Text
templateMajorVersion :: Text
$sel:templateMajorVersion:CreateService' :: CreateService -> Text
templateMajorVersion} -> Text
templateMajorVersion) (\s :: CreateService
s@CreateService' {} Text
a -> CreateService
s {$sel:templateMajorVersion:CreateService' :: Text
templateMajorVersion = Text
a} :: CreateService)

-- | The name of the service template that\'s used to create the service.
createService_templateName :: Lens.Lens' CreateService Prelude.Text
createService_templateName :: Lens' CreateService Text
createService_templateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Text
templateName :: Text
$sel:templateName:CreateService' :: CreateService -> Text
templateName} -> Text
templateName) (\s :: CreateService
s@CreateService' {} Text
a -> CreateService
s {$sel:templateName:CreateService' :: Text
templateName = Text
a} :: CreateService)

instance Core.AWSRequest CreateService where
  type
    AWSResponse CreateService =
      CreateServiceResponse
  request :: (Service -> Service) -> CreateService -> Request CreateService
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 CreateService
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateService)))
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 ->
          Int -> Service -> CreateServiceResponse
CreateServiceResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"service")
      )

instance Prelude.Hashable CreateService where
  hashWithSalt :: Int -> CreateService -> Int
hashWithSalt Int
_salt CreateService' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
templateName :: Text
templateMajorVersion :: Text
spec :: Sensitive Text
name :: Text
templateMinorVersion :: Maybe Text
tags :: Maybe [Tag]
repositoryId :: Maybe Text
repositoryConnectionArn :: Maybe Text
description :: Maybe (Sensitive Text)
branchName :: Maybe Text
$sel:templateName:CreateService' :: CreateService -> Text
$sel:templateMajorVersion:CreateService' :: CreateService -> Text
$sel:spec:CreateService' :: CreateService -> Sensitive Text
$sel:name:CreateService' :: CreateService -> Text
$sel:templateMinorVersion:CreateService' :: CreateService -> Maybe Text
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:repositoryId:CreateService' :: CreateService -> Maybe Text
$sel:repositoryConnectionArn:CreateService' :: CreateService -> Maybe Text
$sel:description:CreateService' :: CreateService -> Maybe (Sensitive Text)
$sel:branchName:CreateService' :: CreateService -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
branchName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
repositoryConnectionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
repositoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateMinorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
spec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateMajorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateName

instance Prelude.NFData CreateService where
  rnf :: CreateService -> ()
rnf CreateService' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
templateName :: Text
templateMajorVersion :: Text
spec :: Sensitive Text
name :: Text
templateMinorVersion :: Maybe Text
tags :: Maybe [Tag]
repositoryId :: Maybe Text
repositoryConnectionArn :: Maybe Text
description :: Maybe (Sensitive Text)
branchName :: Maybe Text
$sel:templateName:CreateService' :: CreateService -> Text
$sel:templateMajorVersion:CreateService' :: CreateService -> Text
$sel:spec:CreateService' :: CreateService -> Sensitive Text
$sel:name:CreateService' :: CreateService -> Text
$sel:templateMinorVersion:CreateService' :: CreateService -> Maybe Text
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:repositoryId:CreateService' :: CreateService -> Maybe Text
$sel:repositoryConnectionArn:CreateService' :: CreateService -> Maybe Text
$sel:description:CreateService' :: CreateService -> Maybe (Sensitive Text)
$sel:branchName:CreateService' :: CreateService -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
branchName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
repositoryConnectionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
repositoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateMinorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
spec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateMajorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateName

instance Data.ToHeaders CreateService where
  toHeaders :: CreateService -> 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
"AwsProton20200720.CreateService" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateService where
  toJSON :: CreateService -> Value
toJSON CreateService' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
templateName :: Text
templateMajorVersion :: Text
spec :: Sensitive Text
name :: Text
templateMinorVersion :: Maybe Text
tags :: Maybe [Tag]
repositoryId :: Maybe Text
repositoryConnectionArn :: Maybe Text
description :: Maybe (Sensitive Text)
branchName :: Maybe Text
$sel:templateName:CreateService' :: CreateService -> Text
$sel:templateMajorVersion:CreateService' :: CreateService -> Text
$sel:spec:CreateService' :: CreateService -> Sensitive Text
$sel:name:CreateService' :: CreateService -> Text
$sel:templateMinorVersion:CreateService' :: CreateService -> Maybe Text
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:repositoryId:CreateService' :: CreateService -> Maybe Text
$sel:repositoryConnectionArn:CreateService' :: CreateService -> Maybe Text
$sel:description:CreateService' :: CreateService -> Maybe (Sensitive Text)
$sel:branchName:CreateService' :: CreateService -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"branchName" 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
branchName,
            (Key
"description" 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 (Sensitive Text)
description,
            (Key
"repositoryConnectionArn" 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
repositoryConnectionArn,
            (Key
"repositoryId" 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
repositoryId,
            (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 [Tag]
tags,
            (Key
"templateMinorVersion" 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
templateMinorVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"spec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
spec),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"templateMajorVersion"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
templateMajorVersion
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"templateName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
templateName)
          ]
      )

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

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

-- | /See:/ 'newCreateServiceResponse' smart constructor.
data CreateServiceResponse = CreateServiceResponse'
  { -- | The response's http status code.
    CreateServiceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The service detail data that\'s returned by Proton.
    CreateServiceResponse -> Service
service :: Service
  }
  deriving (CreateServiceResponse -> CreateServiceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceResponse -> CreateServiceResponse -> Bool
$c/= :: CreateServiceResponse -> CreateServiceResponse -> Bool
== :: CreateServiceResponse -> CreateServiceResponse -> Bool
$c== :: CreateServiceResponse -> CreateServiceResponse -> Bool
Prelude.Eq, Int -> CreateServiceResponse -> ShowS
[CreateServiceResponse] -> ShowS
CreateServiceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceResponse] -> ShowS
$cshowList :: [CreateServiceResponse] -> ShowS
show :: CreateServiceResponse -> String
$cshow :: CreateServiceResponse -> String
showsPrec :: Int -> CreateServiceResponse -> ShowS
$cshowsPrec :: Int -> CreateServiceResponse -> ShowS
Prelude.Show, forall x. Rep CreateServiceResponse x -> CreateServiceResponse
forall x. CreateServiceResponse -> Rep CreateServiceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateServiceResponse x -> CreateServiceResponse
$cfrom :: forall x. CreateServiceResponse -> Rep CreateServiceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceResponse' 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:
--
-- 'httpStatus', 'createServiceResponse_httpStatus' - The response's http status code.
--
-- 'service', 'createServiceResponse_service' - The service detail data that\'s returned by Proton.
newCreateServiceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'service'
  Service ->
  CreateServiceResponse
newCreateServiceResponse :: Int -> Service -> CreateServiceResponse
newCreateServiceResponse Int
pHttpStatus_ Service
pService_ =
  CreateServiceResponse'
    { $sel:httpStatus:CreateServiceResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:service:CreateServiceResponse' :: Service
service = Service
pService_
    }

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

-- | The service detail data that\'s returned by Proton.
createServiceResponse_service :: Lens.Lens' CreateServiceResponse Service
createServiceResponse_service :: Lens' CreateServiceResponse Service
createServiceResponse_service = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceResponse' {Service
service :: Service
$sel:service:CreateServiceResponse' :: CreateServiceResponse -> Service
service} -> Service
service) (\s :: CreateServiceResponse
s@CreateServiceResponse' {} Service
a -> CreateServiceResponse
s {$sel:service:CreateServiceResponse' :: Service
service = Service
a} :: CreateServiceResponse)

instance Prelude.NFData CreateServiceResponse where
  rnf :: CreateServiceResponse -> ()
rnf CreateServiceResponse' {Int
Service
service :: Service
httpStatus :: Int
$sel:service:CreateServiceResponse' :: CreateServiceResponse -> Service
$sel:httpStatus:CreateServiceResponse' :: CreateServiceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Service
service