{-# 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.Mobile.ExportBundle
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates customized software development kit (SDK) and or tool packages
-- used to integrate mobile web or mobile app clients with backend AWS
-- resources.
module Amazonka.Mobile.ExportBundle
  ( -- * Creating a Request
    ExportBundle (..),
    newExportBundle,

    -- * Request Lenses
    exportBundle_platform,
    exportBundle_projectId,
    exportBundle_bundleId,

    -- * Destructuring the Response
    ExportBundleResponse (..),
    newExportBundleResponse,

    -- * Response Lenses
    exportBundleResponse_downloadUrl,
    exportBundleResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Mobile.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Request structure used to request generation of custom SDK and tool
-- packages required to integrate mobile web or app clients with backed AWS
-- resources.
--
-- /See:/ 'newExportBundle' smart constructor.
data ExportBundle = ExportBundle'
  { -- | Developer desktop or target application platform.
    ExportBundle -> Maybe Platform
platform :: Prelude.Maybe Platform,
    -- | Unique project identifier.
    ExportBundle -> Maybe Text
projectId :: Prelude.Maybe Prelude.Text,
    -- | Unique bundle identifier.
    ExportBundle -> Text
bundleId :: Prelude.Text
  }
  deriving (ExportBundle -> ExportBundle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportBundle -> ExportBundle -> Bool
$c/= :: ExportBundle -> ExportBundle -> Bool
== :: ExportBundle -> ExportBundle -> Bool
$c== :: ExportBundle -> ExportBundle -> Bool
Prelude.Eq, ReadPrec [ExportBundle]
ReadPrec ExportBundle
Int -> ReadS ExportBundle
ReadS [ExportBundle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportBundle]
$creadListPrec :: ReadPrec [ExportBundle]
readPrec :: ReadPrec ExportBundle
$creadPrec :: ReadPrec ExportBundle
readList :: ReadS [ExportBundle]
$creadList :: ReadS [ExportBundle]
readsPrec :: Int -> ReadS ExportBundle
$creadsPrec :: Int -> ReadS ExportBundle
Prelude.Read, Int -> ExportBundle -> ShowS
[ExportBundle] -> ShowS
ExportBundle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportBundle] -> ShowS
$cshowList :: [ExportBundle] -> ShowS
show :: ExportBundle -> String
$cshow :: ExportBundle -> String
showsPrec :: Int -> ExportBundle -> ShowS
$cshowsPrec :: Int -> ExportBundle -> ShowS
Prelude.Show, forall x. Rep ExportBundle x -> ExportBundle
forall x. ExportBundle -> Rep ExportBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportBundle x -> ExportBundle
$cfrom :: forall x. ExportBundle -> Rep ExportBundle x
Prelude.Generic)

-- |
-- Create a value of 'ExportBundle' 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:
--
-- 'platform', 'exportBundle_platform' - Developer desktop or target application platform.
--
-- 'projectId', 'exportBundle_projectId' - Unique project identifier.
--
-- 'bundleId', 'exportBundle_bundleId' - Unique bundle identifier.
newExportBundle ::
  -- | 'bundleId'
  Prelude.Text ->
  ExportBundle
newExportBundle :: Text -> ExportBundle
newExportBundle Text
pBundleId_ =
  ExportBundle'
    { $sel:platform:ExportBundle' :: Maybe Platform
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:projectId:ExportBundle' :: Maybe Text
projectId = forall a. Maybe a
Prelude.Nothing,
      $sel:bundleId:ExportBundle' :: Text
bundleId = Text
pBundleId_
    }

-- | Developer desktop or target application platform.
exportBundle_platform :: Lens.Lens' ExportBundle (Prelude.Maybe Platform)
exportBundle_platform :: Lens' ExportBundle (Maybe Platform)
exportBundle_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportBundle' {Maybe Platform
platform :: Maybe Platform
$sel:platform:ExportBundle' :: ExportBundle -> Maybe Platform
platform} -> Maybe Platform
platform) (\s :: ExportBundle
s@ExportBundle' {} Maybe Platform
a -> ExportBundle
s {$sel:platform:ExportBundle' :: Maybe Platform
platform = Maybe Platform
a} :: ExportBundle)

-- | Unique project identifier.
exportBundle_projectId :: Lens.Lens' ExportBundle (Prelude.Maybe Prelude.Text)
exportBundle_projectId :: Lens' ExportBundle (Maybe Text)
exportBundle_projectId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportBundle' {Maybe Text
projectId :: Maybe Text
$sel:projectId:ExportBundle' :: ExportBundle -> Maybe Text
projectId} -> Maybe Text
projectId) (\s :: ExportBundle
s@ExportBundle' {} Maybe Text
a -> ExportBundle
s {$sel:projectId:ExportBundle' :: Maybe Text
projectId = Maybe Text
a} :: ExportBundle)

-- | Unique bundle identifier.
exportBundle_bundleId :: Lens.Lens' ExportBundle Prelude.Text
exportBundle_bundleId :: Lens' ExportBundle Text
exportBundle_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportBundle' {Text
bundleId :: Text
$sel:bundleId:ExportBundle' :: ExportBundle -> Text
bundleId} -> Text
bundleId) (\s :: ExportBundle
s@ExportBundle' {} Text
a -> ExportBundle
s {$sel:bundleId:ExportBundle' :: Text
bundleId = Text
a} :: ExportBundle)

instance Core.AWSRequest ExportBundle where
  type AWSResponse ExportBundle = ExportBundleResponse
  request :: (Service -> Service) -> ExportBundle -> Request ExportBundle
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 ExportBundle
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExportBundle)))
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 Text -> Int -> ExportBundleResponse
ExportBundleResponse'
            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
"downloadUrl")
            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 ExportBundle where
  hashWithSalt :: Int -> ExportBundle -> Int
hashWithSalt Int
_salt ExportBundle' {Maybe Text
Maybe Platform
Text
bundleId :: Text
projectId :: Maybe Text
platform :: Maybe Platform
$sel:bundleId:ExportBundle' :: ExportBundle -> Text
$sel:projectId:ExportBundle' :: ExportBundle -> Maybe Text
$sel:platform:ExportBundle' :: ExportBundle -> Maybe Platform
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Platform
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
projectId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleId

instance Prelude.NFData ExportBundle where
  rnf :: ExportBundle -> ()
rnf ExportBundle' {Maybe Text
Maybe Platform
Text
bundleId :: Text
projectId :: Maybe Text
platform :: Maybe Platform
$sel:bundleId:ExportBundle' :: ExportBundle -> Text
$sel:projectId:ExportBundle' :: ExportBundle -> Maybe Text
$sel:platform:ExportBundle' :: ExportBundle -> Maybe Platform
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Platform
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bundleId

instance Data.ToHeaders ExportBundle where
  toHeaders :: ExportBundle -> 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 ExportBundle where
  toJSON :: ExportBundle -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath ExportBundle where
  toPath :: ExportBundle -> ByteString
toPath ExportBundle' {Maybe Text
Maybe Platform
Text
bundleId :: Text
projectId :: Maybe Text
platform :: Maybe Platform
$sel:bundleId:ExportBundle' :: ExportBundle -> Text
$sel:projectId:ExportBundle' :: ExportBundle -> Maybe Text
$sel:platform:ExportBundle' :: ExportBundle -> Maybe Platform
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/bundles/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
bundleId]

instance Data.ToQuery ExportBundle where
  toQuery :: ExportBundle -> QueryString
toQuery ExportBundle' {Maybe Text
Maybe Platform
Text
bundleId :: Text
projectId :: Maybe Text
platform :: Maybe Platform
$sel:bundleId:ExportBundle' :: ExportBundle -> Text
$sel:projectId:ExportBundle' :: ExportBundle -> Maybe Text
$sel:platform:ExportBundle' :: ExportBundle -> Maybe Platform
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"platform" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Platform
platform,
        ByteString
"projectId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
projectId
      ]

-- | Result structure which contains link to download custom-generated SDK
-- and tool packages used to integrate mobile web or app clients with
-- backed AWS resources.
--
-- /See:/ 'newExportBundleResponse' smart constructor.
data ExportBundleResponse = ExportBundleResponse'
  { -- | URL which contains the custom-generated SDK and tool packages used to
    -- integrate the client mobile app or web app with the AWS resources
    -- created by the AWS Mobile Hub project.
    ExportBundleResponse -> Maybe Text
downloadUrl :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExportBundleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportBundleResponse -> ExportBundleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportBundleResponse -> ExportBundleResponse -> Bool
$c/= :: ExportBundleResponse -> ExportBundleResponse -> Bool
== :: ExportBundleResponse -> ExportBundleResponse -> Bool
$c== :: ExportBundleResponse -> ExportBundleResponse -> Bool
Prelude.Eq, ReadPrec [ExportBundleResponse]
ReadPrec ExportBundleResponse
Int -> ReadS ExportBundleResponse
ReadS [ExportBundleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportBundleResponse]
$creadListPrec :: ReadPrec [ExportBundleResponse]
readPrec :: ReadPrec ExportBundleResponse
$creadPrec :: ReadPrec ExportBundleResponse
readList :: ReadS [ExportBundleResponse]
$creadList :: ReadS [ExportBundleResponse]
readsPrec :: Int -> ReadS ExportBundleResponse
$creadsPrec :: Int -> ReadS ExportBundleResponse
Prelude.Read, Int -> ExportBundleResponse -> ShowS
[ExportBundleResponse] -> ShowS
ExportBundleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportBundleResponse] -> ShowS
$cshowList :: [ExportBundleResponse] -> ShowS
show :: ExportBundleResponse -> String
$cshow :: ExportBundleResponse -> String
showsPrec :: Int -> ExportBundleResponse -> ShowS
$cshowsPrec :: Int -> ExportBundleResponse -> ShowS
Prelude.Show, forall x. Rep ExportBundleResponse x -> ExportBundleResponse
forall x. ExportBundleResponse -> Rep ExportBundleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportBundleResponse x -> ExportBundleResponse
$cfrom :: forall x. ExportBundleResponse -> Rep ExportBundleResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportBundleResponse' 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:
--
-- 'downloadUrl', 'exportBundleResponse_downloadUrl' - URL which contains the custom-generated SDK and tool packages used to
-- integrate the client mobile app or web app with the AWS resources
-- created by the AWS Mobile Hub project.
--
-- 'httpStatus', 'exportBundleResponse_httpStatus' - The response's http status code.
newExportBundleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportBundleResponse
newExportBundleResponse :: Int -> ExportBundleResponse
newExportBundleResponse Int
pHttpStatus_ =
  ExportBundleResponse'
    { $sel:downloadUrl:ExportBundleResponse' :: Maybe Text
downloadUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExportBundleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | URL which contains the custom-generated SDK and tool packages used to
-- integrate the client mobile app or web app with the AWS resources
-- created by the AWS Mobile Hub project.
exportBundleResponse_downloadUrl :: Lens.Lens' ExportBundleResponse (Prelude.Maybe Prelude.Text)
exportBundleResponse_downloadUrl :: Lens' ExportBundleResponse (Maybe Text)
exportBundleResponse_downloadUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportBundleResponse' {Maybe Text
downloadUrl :: Maybe Text
$sel:downloadUrl:ExportBundleResponse' :: ExportBundleResponse -> Maybe Text
downloadUrl} -> Maybe Text
downloadUrl) (\s :: ExportBundleResponse
s@ExportBundleResponse' {} Maybe Text
a -> ExportBundleResponse
s {$sel:downloadUrl:ExportBundleResponse' :: Maybe Text
downloadUrl = Maybe Text
a} :: ExportBundleResponse)

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

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