{-# 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.AppStream.AssociateFleet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates the specified fleet with the specified stack.
module Amazonka.AppStream.AssociateFleet
  ( -- * Creating a Request
    AssociateFleet (..),
    newAssociateFleet,

    -- * Request Lenses
    associateFleet_fleetName,
    associateFleet_stackName,

    -- * Destructuring the Response
    AssociateFleetResponse (..),
    newAssociateFleetResponse,

    -- * Response Lenses
    associateFleetResponse_httpStatus,
  )
where

import Amazonka.AppStream.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:/ 'newAssociateFleet' smart constructor.
data AssociateFleet = AssociateFleet'
  { -- | The name of the fleet.
    AssociateFleet -> Text
fleetName :: Prelude.Text,
    -- | The name of the stack.
    AssociateFleet -> Text
stackName :: Prelude.Text
  }
  deriving (AssociateFleet -> AssociateFleet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateFleet -> AssociateFleet -> Bool
$c/= :: AssociateFleet -> AssociateFleet -> Bool
== :: AssociateFleet -> AssociateFleet -> Bool
$c== :: AssociateFleet -> AssociateFleet -> Bool
Prelude.Eq, ReadPrec [AssociateFleet]
ReadPrec AssociateFleet
Int -> ReadS AssociateFleet
ReadS [AssociateFleet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateFleet]
$creadListPrec :: ReadPrec [AssociateFleet]
readPrec :: ReadPrec AssociateFleet
$creadPrec :: ReadPrec AssociateFleet
readList :: ReadS [AssociateFleet]
$creadList :: ReadS [AssociateFleet]
readsPrec :: Int -> ReadS AssociateFleet
$creadsPrec :: Int -> ReadS AssociateFleet
Prelude.Read, Int -> AssociateFleet -> ShowS
[AssociateFleet] -> ShowS
AssociateFleet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateFleet] -> ShowS
$cshowList :: [AssociateFleet] -> ShowS
show :: AssociateFleet -> String
$cshow :: AssociateFleet -> String
showsPrec :: Int -> AssociateFleet -> ShowS
$cshowsPrec :: Int -> AssociateFleet -> ShowS
Prelude.Show, forall x. Rep AssociateFleet x -> AssociateFleet
forall x. AssociateFleet -> Rep AssociateFleet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateFleet x -> AssociateFleet
$cfrom :: forall x. AssociateFleet -> Rep AssociateFleet x
Prelude.Generic)

-- |
-- Create a value of 'AssociateFleet' 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:
--
-- 'fleetName', 'associateFleet_fleetName' - The name of the fleet.
--
-- 'stackName', 'associateFleet_stackName' - The name of the stack.
newAssociateFleet ::
  -- | 'fleetName'
  Prelude.Text ->
  -- | 'stackName'
  Prelude.Text ->
  AssociateFleet
newAssociateFleet :: Text -> Text -> AssociateFleet
newAssociateFleet Text
pFleetName_ Text
pStackName_ =
  AssociateFleet'
    { $sel:fleetName:AssociateFleet' :: Text
fleetName = Text
pFleetName_,
      $sel:stackName:AssociateFleet' :: Text
stackName = Text
pStackName_
    }

-- | The name of the fleet.
associateFleet_fleetName :: Lens.Lens' AssociateFleet Prelude.Text
associateFleet_fleetName :: Lens' AssociateFleet Text
associateFleet_fleetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFleet' {Text
fleetName :: Text
$sel:fleetName:AssociateFleet' :: AssociateFleet -> Text
fleetName} -> Text
fleetName) (\s :: AssociateFleet
s@AssociateFleet' {} Text
a -> AssociateFleet
s {$sel:fleetName:AssociateFleet' :: Text
fleetName = Text
a} :: AssociateFleet)

-- | The name of the stack.
associateFleet_stackName :: Lens.Lens' AssociateFleet Prelude.Text
associateFleet_stackName :: Lens' AssociateFleet Text
associateFleet_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateFleet' {Text
stackName :: Text
$sel:stackName:AssociateFleet' :: AssociateFleet -> Text
stackName} -> Text
stackName) (\s :: AssociateFleet
s@AssociateFleet' {} Text
a -> AssociateFleet
s {$sel:stackName:AssociateFleet' :: Text
stackName = Text
a} :: AssociateFleet)

instance Core.AWSRequest AssociateFleet where
  type
    AWSResponse AssociateFleet =
      AssociateFleetResponse
  request :: (Service -> Service) -> AssociateFleet -> Request AssociateFleet
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 AssociateFleet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AssociateFleet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateFleetResponse
AssociateFleetResponse'
            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))
      )

instance Prelude.Hashable AssociateFleet where
  hashWithSalt :: Int -> AssociateFleet -> Int
hashWithSalt Int
_salt AssociateFleet' {Text
stackName :: Text
fleetName :: Text
$sel:stackName:AssociateFleet' :: AssociateFleet -> Text
$sel:fleetName:AssociateFleet' :: AssociateFleet -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

instance Prelude.NFData AssociateFleet where
  rnf :: AssociateFleet -> ()
rnf AssociateFleet' {Text
stackName :: Text
fleetName :: Text
$sel:stackName:AssociateFleet' :: AssociateFleet -> Text
$sel:fleetName:AssociateFleet' :: AssociateFleet -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
fleetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackName

instance Data.ToHeaders AssociateFleet where
  toHeaders :: AssociateFleet -> 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
"PhotonAdminProxyService.AssociateFleet" ::
                          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 AssociateFleet where
  toJSON :: AssociateFleet -> Value
toJSON AssociateFleet' {Text
stackName :: Text
fleetName :: Text
$sel:stackName:AssociateFleet' :: AssociateFleet -> Text
$sel:fleetName:AssociateFleet' :: AssociateFleet -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"FleetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetName),
            forall a. a -> Maybe a
Prelude.Just (Key
"StackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackName)
          ]
      )

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

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

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

-- |
-- Create a value of 'AssociateFleetResponse' 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', 'associateFleetResponse_httpStatus' - The response's http status code.
newAssociateFleetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateFleetResponse
newAssociateFleetResponse :: Int -> AssociateFleetResponse
newAssociateFleetResponse Int
pHttpStatus_ =
  AssociateFleetResponse' {$sel:httpStatus:AssociateFleetResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData AssociateFleetResponse where
  rnf :: AssociateFleetResponse -> ()
rnf AssociateFleetResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateFleetResponse' :: AssociateFleetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus