{-# 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.AppConfig.CreateHostedConfigurationVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new configuration in the AppConfig hosted configuration store.
module Amazonka.AppConfig.CreateHostedConfigurationVersion
  ( -- * Creating a Request
    CreateHostedConfigurationVersion (..),
    newCreateHostedConfigurationVersion,

    -- * Request Lenses
    createHostedConfigurationVersion_description,
    createHostedConfigurationVersion_latestVersionNumber,
    createHostedConfigurationVersion_applicationId,
    createHostedConfigurationVersion_configurationProfileId,
    createHostedConfigurationVersion_content,
    createHostedConfigurationVersion_contentType,

    -- * Destructuring the Response
    HostedConfigurationVersion (..),
    newHostedConfigurationVersion,

    -- * Response Lenses
    hostedConfigurationVersion_applicationId,
    hostedConfigurationVersion_configurationProfileId,
    hostedConfigurationVersion_content,
    hostedConfigurationVersion_contentType,
    hostedConfigurationVersion_description,
    hostedConfigurationVersion_versionNumber,
  )
where

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

-- | /See:/ 'newCreateHostedConfigurationVersion' smart constructor.
data CreateHostedConfigurationVersion = CreateHostedConfigurationVersion'
  { -- | A description of the configuration.
    CreateHostedConfigurationVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An optional locking token used to prevent race conditions from
    -- overwriting configuration updates when creating a new version. To ensure
    -- your data is not overwritten when creating multiple hosted configuration
    -- versions in rapid succession, specify the version number of the latest
    -- hosted configuration version.
    CreateHostedConfigurationVersion -> Maybe Int
latestVersionNumber :: Prelude.Maybe Prelude.Int,
    -- | The application ID.
    CreateHostedConfigurationVersion -> Text
applicationId :: Prelude.Text,
    -- | The configuration profile ID.
    CreateHostedConfigurationVersion -> Text
configurationProfileId :: Prelude.Text,
    -- | The content of the configuration or the configuration data.
    CreateHostedConfigurationVersion -> Sensitive ByteString
content :: Data.Sensitive Prelude.ByteString,
    -- | A standard MIME type describing the format of the configuration content.
    -- For more information, see
    -- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.17 Content-Type>.
    CreateHostedConfigurationVersion -> Text
contentType :: Prelude.Text
  }
  deriving (CreateHostedConfigurationVersion
-> CreateHostedConfigurationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHostedConfigurationVersion
-> CreateHostedConfigurationVersion -> Bool
$c/= :: CreateHostedConfigurationVersion
-> CreateHostedConfigurationVersion -> Bool
== :: CreateHostedConfigurationVersion
-> CreateHostedConfigurationVersion -> Bool
$c== :: CreateHostedConfigurationVersion
-> CreateHostedConfigurationVersion -> Bool
Prelude.Eq, Int -> CreateHostedConfigurationVersion -> ShowS
[CreateHostedConfigurationVersion] -> ShowS
CreateHostedConfigurationVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHostedConfigurationVersion] -> ShowS
$cshowList :: [CreateHostedConfigurationVersion] -> ShowS
show :: CreateHostedConfigurationVersion -> String
$cshow :: CreateHostedConfigurationVersion -> String
showsPrec :: Int -> CreateHostedConfigurationVersion -> ShowS
$cshowsPrec :: Int -> CreateHostedConfigurationVersion -> ShowS
Prelude.Show, forall x.
Rep CreateHostedConfigurationVersion x
-> CreateHostedConfigurationVersion
forall x.
CreateHostedConfigurationVersion
-> Rep CreateHostedConfigurationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHostedConfigurationVersion x
-> CreateHostedConfigurationVersion
$cfrom :: forall x.
CreateHostedConfigurationVersion
-> Rep CreateHostedConfigurationVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateHostedConfigurationVersion' 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:
--
-- 'description', 'createHostedConfigurationVersion_description' - A description of the configuration.
--
-- 'latestVersionNumber', 'createHostedConfigurationVersion_latestVersionNumber' - An optional locking token used to prevent race conditions from
-- overwriting configuration updates when creating a new version. To ensure
-- your data is not overwritten when creating multiple hosted configuration
-- versions in rapid succession, specify the version number of the latest
-- hosted configuration version.
--
-- 'applicationId', 'createHostedConfigurationVersion_applicationId' - The application ID.
--
-- 'configurationProfileId', 'createHostedConfigurationVersion_configurationProfileId' - The configuration profile ID.
--
-- 'content', 'createHostedConfigurationVersion_content' - The content of the configuration or the configuration data.
--
-- 'contentType', 'createHostedConfigurationVersion_contentType' - A standard MIME type describing the format of the configuration content.
-- For more information, see
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.17 Content-Type>.
newCreateHostedConfigurationVersion ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'configurationProfileId'
  Prelude.Text ->
  -- | 'content'
  Prelude.ByteString ->
  -- | 'contentType'
  Prelude.Text ->
  CreateHostedConfigurationVersion
newCreateHostedConfigurationVersion :: Text
-> Text -> ByteString -> Text -> CreateHostedConfigurationVersion
newCreateHostedConfigurationVersion
  Text
pApplicationId_
  Text
pConfigurationProfileId_
  ByteString
pContent_
  Text
pContentType_ =
    CreateHostedConfigurationVersion'
      { $sel:description:CreateHostedConfigurationVersion' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:latestVersionNumber:CreateHostedConfigurationVersion' :: Maybe Int
latestVersionNumber = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:CreateHostedConfigurationVersion' :: Text
applicationId = Text
pApplicationId_,
        $sel:configurationProfileId:CreateHostedConfigurationVersion' :: Text
configurationProfileId =
          Text
pConfigurationProfileId_,
        $sel:content:CreateHostedConfigurationVersion' :: Sensitive ByteString
content =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ByteString
pContent_,
        $sel:contentType:CreateHostedConfigurationVersion' :: Text
contentType = Text
pContentType_
      }

-- | A description of the configuration.
createHostedConfigurationVersion_description :: Lens.Lens' CreateHostedConfigurationVersion (Prelude.Maybe Prelude.Text)
createHostedConfigurationVersion_description :: Lens' CreateHostedConfigurationVersion (Maybe Text)
createHostedConfigurationVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Maybe Text
description :: Maybe Text
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Maybe Text
a -> CreateHostedConfigurationVersion
s {$sel:description:CreateHostedConfigurationVersion' :: Maybe Text
description = Maybe Text
a} :: CreateHostedConfigurationVersion)

-- | An optional locking token used to prevent race conditions from
-- overwriting configuration updates when creating a new version. To ensure
-- your data is not overwritten when creating multiple hosted configuration
-- versions in rapid succession, specify the version number of the latest
-- hosted configuration version.
createHostedConfigurationVersion_latestVersionNumber :: Lens.Lens' CreateHostedConfigurationVersion (Prelude.Maybe Prelude.Int)
createHostedConfigurationVersion_latestVersionNumber :: Lens' CreateHostedConfigurationVersion (Maybe Int)
createHostedConfigurationVersion_latestVersionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Maybe Int
latestVersionNumber :: Maybe Int
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
latestVersionNumber} -> Maybe Int
latestVersionNumber) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Maybe Int
a -> CreateHostedConfigurationVersion
s {$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: Maybe Int
latestVersionNumber = Maybe Int
a} :: CreateHostedConfigurationVersion)

-- | The application ID.
createHostedConfigurationVersion_applicationId :: Lens.Lens' CreateHostedConfigurationVersion Prelude.Text
createHostedConfigurationVersion_applicationId :: Lens' CreateHostedConfigurationVersion Text
createHostedConfigurationVersion_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Text
applicationId :: Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
applicationId} -> Text
applicationId) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Text
a -> CreateHostedConfigurationVersion
s {$sel:applicationId:CreateHostedConfigurationVersion' :: Text
applicationId = Text
a} :: CreateHostedConfigurationVersion)

-- | The configuration profile ID.
createHostedConfigurationVersion_configurationProfileId :: Lens.Lens' CreateHostedConfigurationVersion Prelude.Text
createHostedConfigurationVersion_configurationProfileId :: Lens' CreateHostedConfigurationVersion Text
createHostedConfigurationVersion_configurationProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Text
configurationProfileId :: Text
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
configurationProfileId} -> Text
configurationProfileId) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Text
a -> CreateHostedConfigurationVersion
s {$sel:configurationProfileId:CreateHostedConfigurationVersion' :: Text
configurationProfileId = Text
a} :: CreateHostedConfigurationVersion)

-- | The content of the configuration or the configuration data.
createHostedConfigurationVersion_content :: Lens.Lens' CreateHostedConfigurationVersion Prelude.ByteString
createHostedConfigurationVersion_content :: Lens' CreateHostedConfigurationVersion ByteString
createHostedConfigurationVersion_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Sensitive ByteString
content :: Sensitive ByteString
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
content} -> Sensitive ByteString
content) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Sensitive ByteString
a -> CreateHostedConfigurationVersion
s {$sel:content:CreateHostedConfigurationVersion' :: Sensitive ByteString
content = Sensitive ByteString
a} :: CreateHostedConfigurationVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A standard MIME type describing the format of the configuration content.
-- For more information, see
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.17 Content-Type>.
createHostedConfigurationVersion_contentType :: Lens.Lens' CreateHostedConfigurationVersion Prelude.Text
createHostedConfigurationVersion_contentType :: Lens' CreateHostedConfigurationVersion Text
createHostedConfigurationVersion_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostedConfigurationVersion' {Text
contentType :: Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
contentType} -> Text
contentType) (\s :: CreateHostedConfigurationVersion
s@CreateHostedConfigurationVersion' {} Text
a -> CreateHostedConfigurationVersion
s {$sel:contentType:CreateHostedConfigurationVersion' :: Text
contentType = Text
a} :: CreateHostedConfigurationVersion)

instance
  Core.AWSRequest
    CreateHostedConfigurationVersion
  where
  type
    AWSResponse CreateHostedConfigurationVersion =
      HostedConfigurationVersion
  request :: (Service -> Service)
-> CreateHostedConfigurationVersion
-> Request CreateHostedConfigurationVersion
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.postBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateHostedConfigurationVersion
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateHostedConfigurationVersion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe Text
-> Maybe Text
-> Maybe (Sensitive ByteString)
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> HostedConfigurationVersion
HostedConfigurationVersion'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Application-Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Configuration-Profile-Id")
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Version-Number")
      )

instance
  Prelude.Hashable
    CreateHostedConfigurationVersion
  where
  hashWithSalt :: Int -> CreateHostedConfigurationVersion -> Int
hashWithSalt
    Int
_salt
    CreateHostedConfigurationVersion' {Maybe Int
Maybe Text
Text
Sensitive ByteString
contentType :: Text
content :: Sensitive ByteString
configurationProfileId :: Text
applicationId :: Text
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
latestVersionNumber
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationProfileId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive ByteString
content
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentType

instance
  Prelude.NFData
    CreateHostedConfigurationVersion
  where
  rnf :: CreateHostedConfigurationVersion -> ()
rnf CreateHostedConfigurationVersion' {Maybe Int
Maybe Text
Text
Sensitive ByteString
contentType :: Text
content :: Sensitive ByteString
configurationProfileId :: Text
applicationId :: Text
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
latestVersionNumber
      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 Text
configurationProfileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive ByteString
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contentType

instance Data.ToBody CreateHostedConfigurationVersion where
  toBody :: CreateHostedConfigurationVersion -> RequestBody
toBody CreateHostedConfigurationVersion' {Maybe Int
Maybe Text
Text
Sensitive ByteString
contentType :: Text
content :: Sensitive ByteString
configurationProfileId :: Text
applicationId :: Text
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
..} =
    forall a. ToBody a => a -> RequestBody
Data.toBody Sensitive ByteString
content

instance
  Data.ToHeaders
    CreateHostedConfigurationVersion
  where
  toHeaders :: CreateHostedConfigurationVersion -> ResponseHeaders
toHeaders CreateHostedConfigurationVersion' {Maybe Int
Maybe Text
Text
Sensitive ByteString
contentType :: Text
content :: Sensitive ByteString
configurationProfileId :: Text
applicationId :: Text
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Description" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
description,
        HeaderName
"Latest-Version-Number" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Int
latestVersionNumber,
        HeaderName
"Content-Type" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
contentType
      ]

instance Data.ToPath CreateHostedConfigurationVersion where
  toPath :: CreateHostedConfigurationVersion -> ByteString
toPath CreateHostedConfigurationVersion' {Maybe Int
Maybe Text
Text
Sensitive ByteString
contentType :: Text
content :: Sensitive ByteString
configurationProfileId :: Text
applicationId :: Text
latestVersionNumber :: Maybe Int
description :: Maybe Text
$sel:contentType:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:content:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Sensitive ByteString
$sel:configurationProfileId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:applicationId:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Text
$sel:latestVersionNumber:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Int
$sel:description:CreateHostedConfigurationVersion' :: CreateHostedConfigurationVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/configurationprofiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
configurationProfileId,
        ByteString
"/hostedconfigurationversions"
      ]

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