{-# 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.DescribeBundle
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the bundle details for the requested bundle id.
module Amazonka.Mobile.DescribeBundle
  ( -- * Creating a Request
    DescribeBundle (..),
    newDescribeBundle,

    -- * Request Lenses
    describeBundle_bundleId,

    -- * Destructuring the Response
    DescribeBundleResponse (..),
    newDescribeBundleResponse,

    -- * Response Lenses
    describeBundleResponse_details,
    describeBundleResponse_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 to request the details of a specific bundle.
--
-- /See:/ 'newDescribeBundle' smart constructor.
data DescribeBundle = DescribeBundle'
  { -- | Unique bundle identifier.
    DescribeBundle -> Text
bundleId :: Prelude.Text
  }
  deriving (DescribeBundle -> DescribeBundle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBundle -> DescribeBundle -> Bool
$c/= :: DescribeBundle -> DescribeBundle -> Bool
== :: DescribeBundle -> DescribeBundle -> Bool
$c== :: DescribeBundle -> DescribeBundle -> Bool
Prelude.Eq, ReadPrec [DescribeBundle]
ReadPrec DescribeBundle
Int -> ReadS DescribeBundle
ReadS [DescribeBundle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBundle]
$creadListPrec :: ReadPrec [DescribeBundle]
readPrec :: ReadPrec DescribeBundle
$creadPrec :: ReadPrec DescribeBundle
readList :: ReadS [DescribeBundle]
$creadList :: ReadS [DescribeBundle]
readsPrec :: Int -> ReadS DescribeBundle
$creadsPrec :: Int -> ReadS DescribeBundle
Prelude.Read, Int -> DescribeBundle -> ShowS
[DescribeBundle] -> ShowS
DescribeBundle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBundle] -> ShowS
$cshowList :: [DescribeBundle] -> ShowS
show :: DescribeBundle -> String
$cshow :: DescribeBundle -> String
showsPrec :: Int -> DescribeBundle -> ShowS
$cshowsPrec :: Int -> DescribeBundle -> ShowS
Prelude.Show, forall x. Rep DescribeBundle x -> DescribeBundle
forall x. DescribeBundle -> Rep DescribeBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeBundle x -> DescribeBundle
$cfrom :: forall x. DescribeBundle -> Rep DescribeBundle x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBundle' 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:
--
-- 'bundleId', 'describeBundle_bundleId' - Unique bundle identifier.
newDescribeBundle ::
  -- | 'bundleId'
  Prelude.Text ->
  DescribeBundle
newDescribeBundle :: Text -> DescribeBundle
newDescribeBundle Text
pBundleId_ =
  DescribeBundle' {$sel:bundleId:DescribeBundle' :: Text
bundleId = Text
pBundleId_}

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

instance Core.AWSRequest DescribeBundle where
  type
    AWSResponse DescribeBundle =
      DescribeBundleResponse
  request :: (Service -> Service) -> DescribeBundle -> Request DescribeBundle
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeBundle
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeBundle)))
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 BundleDetails -> Int -> DescribeBundleResponse
DescribeBundleResponse'
            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
"details")
            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 DescribeBundle where
  hashWithSalt :: Int -> DescribeBundle -> Int
hashWithSalt Int
_salt DescribeBundle' {Text
bundleId :: Text
$sel:bundleId:DescribeBundle' :: DescribeBundle -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleId

instance Prelude.NFData DescribeBundle where
  rnf :: DescribeBundle -> ()
rnf DescribeBundle' {Text
bundleId :: Text
$sel:bundleId:DescribeBundle' :: DescribeBundle -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
bundleId

instance Data.ToHeaders DescribeBundle where
  toHeaders :: DescribeBundle -> 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.ToPath DescribeBundle where
  toPath :: DescribeBundle -> ByteString
toPath DescribeBundle' {Text
bundleId :: Text
$sel:bundleId:DescribeBundle' :: DescribeBundle -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/bundles/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
bundleId]

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

-- | Result structure contains the details of the bundle.
--
-- /See:/ 'newDescribeBundleResponse' smart constructor.
data DescribeBundleResponse = DescribeBundleResponse'
  { -- | The details of the bundle.
    DescribeBundleResponse -> Maybe BundleDetails
details :: Prelude.Maybe BundleDetails,
    -- | The response's http status code.
    DescribeBundleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeBundleResponse -> DescribeBundleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBundleResponse -> DescribeBundleResponse -> Bool
$c/= :: DescribeBundleResponse -> DescribeBundleResponse -> Bool
== :: DescribeBundleResponse -> DescribeBundleResponse -> Bool
$c== :: DescribeBundleResponse -> DescribeBundleResponse -> Bool
Prelude.Eq, ReadPrec [DescribeBundleResponse]
ReadPrec DescribeBundleResponse
Int -> ReadS DescribeBundleResponse
ReadS [DescribeBundleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBundleResponse]
$creadListPrec :: ReadPrec [DescribeBundleResponse]
readPrec :: ReadPrec DescribeBundleResponse
$creadPrec :: ReadPrec DescribeBundleResponse
readList :: ReadS [DescribeBundleResponse]
$creadList :: ReadS [DescribeBundleResponse]
readsPrec :: Int -> ReadS DescribeBundleResponse
$creadsPrec :: Int -> ReadS DescribeBundleResponse
Prelude.Read, Int -> DescribeBundleResponse -> ShowS
[DescribeBundleResponse] -> ShowS
DescribeBundleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBundleResponse] -> ShowS
$cshowList :: [DescribeBundleResponse] -> ShowS
show :: DescribeBundleResponse -> String
$cshow :: DescribeBundleResponse -> String
showsPrec :: Int -> DescribeBundleResponse -> ShowS
$cshowsPrec :: Int -> DescribeBundleResponse -> ShowS
Prelude.Show, forall x. Rep DescribeBundleResponse x -> DescribeBundleResponse
forall x. DescribeBundleResponse -> Rep DescribeBundleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeBundleResponse x -> DescribeBundleResponse
$cfrom :: forall x. DescribeBundleResponse -> Rep DescribeBundleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBundleResponse' 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:
--
-- 'details', 'describeBundleResponse_details' - The details of the bundle.
--
-- 'httpStatus', 'describeBundleResponse_httpStatus' - The response's http status code.
newDescribeBundleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeBundleResponse
newDescribeBundleResponse :: Int -> DescribeBundleResponse
newDescribeBundleResponse Int
pHttpStatus_ =
  DescribeBundleResponse'
    { $sel:details:DescribeBundleResponse' :: Maybe BundleDetails
details = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeBundleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details of the bundle.
describeBundleResponse_details :: Lens.Lens' DescribeBundleResponse (Prelude.Maybe BundleDetails)
describeBundleResponse_details :: Lens' DescribeBundleResponse (Maybe BundleDetails)
describeBundleResponse_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleResponse' {Maybe BundleDetails
details :: Maybe BundleDetails
$sel:details:DescribeBundleResponse' :: DescribeBundleResponse -> Maybe BundleDetails
details} -> Maybe BundleDetails
details) (\s :: DescribeBundleResponse
s@DescribeBundleResponse' {} Maybe BundleDetails
a -> DescribeBundleResponse
s {$sel:details:DescribeBundleResponse' :: Maybe BundleDetails
details = Maybe BundleDetails
a} :: DescribeBundleResponse)

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

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