{-# 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.DeviceFarm.CreateInstanceProfile
-- 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 profile that can be applied to one or more private fleet
-- device instances.
module Amazonka.DeviceFarm.CreateInstanceProfile
  ( -- * Creating a Request
    CreateInstanceProfile (..),
    newCreateInstanceProfile,

    -- * Request Lenses
    createInstanceProfile_description,
    createInstanceProfile_excludeAppPackagesFromCleanup,
    createInstanceProfile_packageCleanup,
    createInstanceProfile_rebootAfterUse,
    createInstanceProfile_name,

    -- * Destructuring the Response
    CreateInstanceProfileResponse (..),
    newCreateInstanceProfileResponse,

    -- * Response Lenses
    createInstanceProfileResponse_instanceProfile,
    createInstanceProfileResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateInstanceProfile' smart constructor.
data CreateInstanceProfile = CreateInstanceProfile'
  { -- | The description of your instance profile.
    CreateInstanceProfile -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An array of strings that specifies the list of app packages that should
    -- not be cleaned up from the device after a test run.
    --
    -- The list of packages is considered only if you set @packageCleanup@ to
    -- @true@.
    CreateInstanceProfile -> Maybe [Text]
excludeAppPackagesFromCleanup :: Prelude.Maybe [Prelude.Text],
    -- | When set to @true@, Device Farm removes app packages after a test run.
    -- The default value is @false@ for private devices.
    CreateInstanceProfile -> Maybe Bool
packageCleanup :: Prelude.Maybe Prelude.Bool,
    -- | When set to @true@, Device Farm reboots the instance after a test run.
    -- The default value is @true@.
    CreateInstanceProfile -> Maybe Bool
rebootAfterUse :: Prelude.Maybe Prelude.Bool,
    -- | The name of your instance profile.
    CreateInstanceProfile -> Text
name :: Prelude.Text
  }
  deriving (CreateInstanceProfile -> CreateInstanceProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInstanceProfile -> CreateInstanceProfile -> Bool
$c/= :: CreateInstanceProfile -> CreateInstanceProfile -> Bool
== :: CreateInstanceProfile -> CreateInstanceProfile -> Bool
$c== :: CreateInstanceProfile -> CreateInstanceProfile -> Bool
Prelude.Eq, ReadPrec [CreateInstanceProfile]
ReadPrec CreateInstanceProfile
Int -> ReadS CreateInstanceProfile
ReadS [CreateInstanceProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInstanceProfile]
$creadListPrec :: ReadPrec [CreateInstanceProfile]
readPrec :: ReadPrec CreateInstanceProfile
$creadPrec :: ReadPrec CreateInstanceProfile
readList :: ReadS [CreateInstanceProfile]
$creadList :: ReadS [CreateInstanceProfile]
readsPrec :: Int -> ReadS CreateInstanceProfile
$creadsPrec :: Int -> ReadS CreateInstanceProfile
Prelude.Read, Int -> CreateInstanceProfile -> ShowS
[CreateInstanceProfile] -> ShowS
CreateInstanceProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInstanceProfile] -> ShowS
$cshowList :: [CreateInstanceProfile] -> ShowS
show :: CreateInstanceProfile -> String
$cshow :: CreateInstanceProfile -> String
showsPrec :: Int -> CreateInstanceProfile -> ShowS
$cshowsPrec :: Int -> CreateInstanceProfile -> ShowS
Prelude.Show, forall x. Rep CreateInstanceProfile x -> CreateInstanceProfile
forall x. CreateInstanceProfile -> Rep CreateInstanceProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInstanceProfile x -> CreateInstanceProfile
$cfrom :: forall x. CreateInstanceProfile -> Rep CreateInstanceProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateInstanceProfile' 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', 'createInstanceProfile_description' - The description of your instance profile.
--
-- 'excludeAppPackagesFromCleanup', 'createInstanceProfile_excludeAppPackagesFromCleanup' - An array of strings that specifies the list of app packages that should
-- not be cleaned up from the device after a test run.
--
-- The list of packages is considered only if you set @packageCleanup@ to
-- @true@.
--
-- 'packageCleanup', 'createInstanceProfile_packageCleanup' - When set to @true@, Device Farm removes app packages after a test run.
-- The default value is @false@ for private devices.
--
-- 'rebootAfterUse', 'createInstanceProfile_rebootAfterUse' - When set to @true@, Device Farm reboots the instance after a test run.
-- The default value is @true@.
--
-- 'name', 'createInstanceProfile_name' - The name of your instance profile.
newCreateInstanceProfile ::
  -- | 'name'
  Prelude.Text ->
  CreateInstanceProfile
newCreateInstanceProfile :: Text -> CreateInstanceProfile
newCreateInstanceProfile Text
pName_ =
  CreateInstanceProfile'
    { $sel:description:CreateInstanceProfile' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: Maybe [Text]
excludeAppPackagesFromCleanup = forall a. Maybe a
Prelude.Nothing,
      $sel:packageCleanup:CreateInstanceProfile' :: Maybe Bool
packageCleanup = forall a. Maybe a
Prelude.Nothing,
      $sel:rebootAfterUse:CreateInstanceProfile' :: Maybe Bool
rebootAfterUse = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateInstanceProfile' :: Text
name = Text
pName_
    }

-- | The description of your instance profile.
createInstanceProfile_description :: Lens.Lens' CreateInstanceProfile (Prelude.Maybe Prelude.Text)
createInstanceProfile_description :: Lens' CreateInstanceProfile (Maybe Text)
createInstanceProfile_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfile' {Maybe Text
description :: Maybe Text
$sel:description:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateInstanceProfile
s@CreateInstanceProfile' {} Maybe Text
a -> CreateInstanceProfile
s {$sel:description:CreateInstanceProfile' :: Maybe Text
description = Maybe Text
a} :: CreateInstanceProfile)

-- | An array of strings that specifies the list of app packages that should
-- not be cleaned up from the device after a test run.
--
-- The list of packages is considered only if you set @packageCleanup@ to
-- @true@.
createInstanceProfile_excludeAppPackagesFromCleanup :: Lens.Lens' CreateInstanceProfile (Prelude.Maybe [Prelude.Text])
createInstanceProfile_excludeAppPackagesFromCleanup :: Lens' CreateInstanceProfile (Maybe [Text])
createInstanceProfile_excludeAppPackagesFromCleanup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfile' {Maybe [Text]
excludeAppPackagesFromCleanup :: Maybe [Text]
$sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe [Text]
excludeAppPackagesFromCleanup} -> Maybe [Text]
excludeAppPackagesFromCleanup) (\s :: CreateInstanceProfile
s@CreateInstanceProfile' {} Maybe [Text]
a -> CreateInstanceProfile
s {$sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: Maybe [Text]
excludeAppPackagesFromCleanup = Maybe [Text]
a} :: CreateInstanceProfile) 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

-- | When set to @true@, Device Farm removes app packages after a test run.
-- The default value is @false@ for private devices.
createInstanceProfile_packageCleanup :: Lens.Lens' CreateInstanceProfile (Prelude.Maybe Prelude.Bool)
createInstanceProfile_packageCleanup :: Lens' CreateInstanceProfile (Maybe Bool)
createInstanceProfile_packageCleanup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfile' {Maybe Bool
packageCleanup :: Maybe Bool
$sel:packageCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
packageCleanup} -> Maybe Bool
packageCleanup) (\s :: CreateInstanceProfile
s@CreateInstanceProfile' {} Maybe Bool
a -> CreateInstanceProfile
s {$sel:packageCleanup:CreateInstanceProfile' :: Maybe Bool
packageCleanup = Maybe Bool
a} :: CreateInstanceProfile)

-- | When set to @true@, Device Farm reboots the instance after a test run.
-- The default value is @true@.
createInstanceProfile_rebootAfterUse :: Lens.Lens' CreateInstanceProfile (Prelude.Maybe Prelude.Bool)
createInstanceProfile_rebootAfterUse :: Lens' CreateInstanceProfile (Maybe Bool)
createInstanceProfile_rebootAfterUse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfile' {Maybe Bool
rebootAfterUse :: Maybe Bool
$sel:rebootAfterUse:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
rebootAfterUse} -> Maybe Bool
rebootAfterUse) (\s :: CreateInstanceProfile
s@CreateInstanceProfile' {} Maybe Bool
a -> CreateInstanceProfile
s {$sel:rebootAfterUse:CreateInstanceProfile' :: Maybe Bool
rebootAfterUse = Maybe Bool
a} :: CreateInstanceProfile)

-- | The name of your instance profile.
createInstanceProfile_name :: Lens.Lens' CreateInstanceProfile Prelude.Text
createInstanceProfile_name :: Lens' CreateInstanceProfile Text
createInstanceProfile_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfile' {Text
name :: Text
$sel:name:CreateInstanceProfile' :: CreateInstanceProfile -> Text
name} -> Text
name) (\s :: CreateInstanceProfile
s@CreateInstanceProfile' {} Text
a -> CreateInstanceProfile
s {$sel:name:CreateInstanceProfile' :: Text
name = Text
a} :: CreateInstanceProfile)

instance Core.AWSRequest CreateInstanceProfile where
  type
    AWSResponse CreateInstanceProfile =
      CreateInstanceProfileResponse
  request :: (Service -> Service)
-> CreateInstanceProfile -> Request CreateInstanceProfile
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 CreateInstanceProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateInstanceProfile)))
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 InstanceProfile -> Int -> CreateInstanceProfileResponse
CreateInstanceProfileResponse'
            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
"instanceProfile")
            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 CreateInstanceProfile where
  hashWithSalt :: Int -> CreateInstanceProfile -> Int
hashWithSalt Int
_salt CreateInstanceProfile' {Maybe Bool
Maybe [Text]
Maybe Text
Text
name :: Text
rebootAfterUse :: Maybe Bool
packageCleanup :: Maybe Bool
excludeAppPackagesFromCleanup :: Maybe [Text]
description :: Maybe Text
$sel:name:CreateInstanceProfile' :: CreateInstanceProfile -> Text
$sel:rebootAfterUse:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:packageCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe [Text]
$sel:description:CreateInstanceProfile' :: CreateInstanceProfile -> 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 [Text]
excludeAppPackagesFromCleanup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
packageCleanup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
rebootAfterUse
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateInstanceProfile where
  rnf :: CreateInstanceProfile -> ()
rnf CreateInstanceProfile' {Maybe Bool
Maybe [Text]
Maybe Text
Text
name :: Text
rebootAfterUse :: Maybe Bool
packageCleanup :: Maybe Bool
excludeAppPackagesFromCleanup :: Maybe [Text]
description :: Maybe Text
$sel:name:CreateInstanceProfile' :: CreateInstanceProfile -> Text
$sel:rebootAfterUse:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:packageCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe [Text]
$sel:description:CreateInstanceProfile' :: CreateInstanceProfile -> 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 [Text]
excludeAppPackagesFromCleanup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
packageCleanup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
rebootAfterUse
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON CreateInstanceProfile where
  toJSON :: CreateInstanceProfile -> Value
toJSON CreateInstanceProfile' {Maybe Bool
Maybe [Text]
Maybe Text
Text
name :: Text
rebootAfterUse :: Maybe Bool
packageCleanup :: Maybe Bool
excludeAppPackagesFromCleanup :: Maybe [Text]
description :: Maybe Text
$sel:name:CreateInstanceProfile' :: CreateInstanceProfile -> Text
$sel:rebootAfterUse:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:packageCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Bool
$sel:excludeAppPackagesFromCleanup:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe [Text]
$sel:description:CreateInstanceProfile' :: CreateInstanceProfile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 Text
description,
            (Key
"excludeAppPackagesFromCleanup" 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]
excludeAppPackagesFromCleanup,
            (Key
"packageCleanup" 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 Bool
packageCleanup,
            (Key
"rebootAfterUse" 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 Bool
rebootAfterUse,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateInstanceProfileResponse' smart constructor.
data CreateInstanceProfileResponse = CreateInstanceProfileResponse'
  { -- | An object that contains information about your instance profile.
    CreateInstanceProfileResponse -> Maybe InstanceProfile
instanceProfile :: Prelude.Maybe InstanceProfile,
    -- | The response's http status code.
    CreateInstanceProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateInstanceProfileResponse
-> CreateInstanceProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInstanceProfileResponse
-> CreateInstanceProfileResponse -> Bool
$c/= :: CreateInstanceProfileResponse
-> CreateInstanceProfileResponse -> Bool
== :: CreateInstanceProfileResponse
-> CreateInstanceProfileResponse -> Bool
$c== :: CreateInstanceProfileResponse
-> CreateInstanceProfileResponse -> Bool
Prelude.Eq, ReadPrec [CreateInstanceProfileResponse]
ReadPrec CreateInstanceProfileResponse
Int -> ReadS CreateInstanceProfileResponse
ReadS [CreateInstanceProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInstanceProfileResponse]
$creadListPrec :: ReadPrec [CreateInstanceProfileResponse]
readPrec :: ReadPrec CreateInstanceProfileResponse
$creadPrec :: ReadPrec CreateInstanceProfileResponse
readList :: ReadS [CreateInstanceProfileResponse]
$creadList :: ReadS [CreateInstanceProfileResponse]
readsPrec :: Int -> ReadS CreateInstanceProfileResponse
$creadsPrec :: Int -> ReadS CreateInstanceProfileResponse
Prelude.Read, Int -> CreateInstanceProfileResponse -> ShowS
[CreateInstanceProfileResponse] -> ShowS
CreateInstanceProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInstanceProfileResponse] -> ShowS
$cshowList :: [CreateInstanceProfileResponse] -> ShowS
show :: CreateInstanceProfileResponse -> String
$cshow :: CreateInstanceProfileResponse -> String
showsPrec :: Int -> CreateInstanceProfileResponse -> ShowS
$cshowsPrec :: Int -> CreateInstanceProfileResponse -> ShowS
Prelude.Show, forall x.
Rep CreateInstanceProfileResponse x
-> CreateInstanceProfileResponse
forall x.
CreateInstanceProfileResponse
-> Rep CreateInstanceProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateInstanceProfileResponse x
-> CreateInstanceProfileResponse
$cfrom :: forall x.
CreateInstanceProfileResponse
-> Rep CreateInstanceProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateInstanceProfileResponse' 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:
--
-- 'instanceProfile', 'createInstanceProfileResponse_instanceProfile' - An object that contains information about your instance profile.
--
-- 'httpStatus', 'createInstanceProfileResponse_httpStatus' - The response's http status code.
newCreateInstanceProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateInstanceProfileResponse
newCreateInstanceProfileResponse :: Int -> CreateInstanceProfileResponse
newCreateInstanceProfileResponse Int
pHttpStatus_ =
  CreateInstanceProfileResponse'
    { $sel:instanceProfile:CreateInstanceProfileResponse' :: Maybe InstanceProfile
instanceProfile =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateInstanceProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that contains information about your instance profile.
createInstanceProfileResponse_instanceProfile :: Lens.Lens' CreateInstanceProfileResponse (Prelude.Maybe InstanceProfile)
createInstanceProfileResponse_instanceProfile :: Lens' CreateInstanceProfileResponse (Maybe InstanceProfile)
createInstanceProfileResponse_instanceProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceProfileResponse' {Maybe InstanceProfile
instanceProfile :: Maybe InstanceProfile
$sel:instanceProfile:CreateInstanceProfileResponse' :: CreateInstanceProfileResponse -> Maybe InstanceProfile
instanceProfile} -> Maybe InstanceProfile
instanceProfile) (\s :: CreateInstanceProfileResponse
s@CreateInstanceProfileResponse' {} Maybe InstanceProfile
a -> CreateInstanceProfileResponse
s {$sel:instanceProfile:CreateInstanceProfileResponse' :: Maybe InstanceProfile
instanceProfile = Maybe InstanceProfile
a} :: CreateInstanceProfileResponse)

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

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