{-# 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.WorkSpaces.RebootWorkspaces
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reboots the specified WorkSpaces.
--
-- You cannot reboot a WorkSpace unless its state is @AVAILABLE@ or
-- @UNHEALTHY@.
--
-- This operation is asynchronous and returns before the WorkSpaces have
-- rebooted.
module Amazonka.WorkSpaces.RebootWorkspaces
  ( -- * Creating a Request
    RebootWorkspaces (..),
    newRebootWorkspaces,

    -- * Request Lenses
    rebootWorkspaces_rebootWorkspaceRequests,

    -- * Destructuring the Response
    RebootWorkspacesResponse (..),
    newRebootWorkspacesResponse,

    -- * Response Lenses
    rebootWorkspacesResponse_failedRequests,
    rebootWorkspacesResponse_httpStatus,
  )
where

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
import Amazonka.WorkSpaces.Types

-- | /See:/ 'newRebootWorkspaces' smart constructor.
data RebootWorkspaces = RebootWorkspaces'
  { -- | The WorkSpaces to reboot. You can specify up to 25 WorkSpaces.
    RebootWorkspaces -> NonEmpty RebootRequest
rebootWorkspaceRequests :: Prelude.NonEmpty RebootRequest
  }
  deriving (RebootWorkspaces -> RebootWorkspaces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootWorkspaces -> RebootWorkspaces -> Bool
$c/= :: RebootWorkspaces -> RebootWorkspaces -> Bool
== :: RebootWorkspaces -> RebootWorkspaces -> Bool
$c== :: RebootWorkspaces -> RebootWorkspaces -> Bool
Prelude.Eq, ReadPrec [RebootWorkspaces]
ReadPrec RebootWorkspaces
Int -> ReadS RebootWorkspaces
ReadS [RebootWorkspaces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootWorkspaces]
$creadListPrec :: ReadPrec [RebootWorkspaces]
readPrec :: ReadPrec RebootWorkspaces
$creadPrec :: ReadPrec RebootWorkspaces
readList :: ReadS [RebootWorkspaces]
$creadList :: ReadS [RebootWorkspaces]
readsPrec :: Int -> ReadS RebootWorkspaces
$creadsPrec :: Int -> ReadS RebootWorkspaces
Prelude.Read, Int -> RebootWorkspaces -> ShowS
[RebootWorkspaces] -> ShowS
RebootWorkspaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootWorkspaces] -> ShowS
$cshowList :: [RebootWorkspaces] -> ShowS
show :: RebootWorkspaces -> String
$cshow :: RebootWorkspaces -> String
showsPrec :: Int -> RebootWorkspaces -> ShowS
$cshowsPrec :: Int -> RebootWorkspaces -> ShowS
Prelude.Show, forall x. Rep RebootWorkspaces x -> RebootWorkspaces
forall x. RebootWorkspaces -> Rep RebootWorkspaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RebootWorkspaces x -> RebootWorkspaces
$cfrom :: forall x. RebootWorkspaces -> Rep RebootWorkspaces x
Prelude.Generic)

-- |
-- Create a value of 'RebootWorkspaces' 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:
--
-- 'rebootWorkspaceRequests', 'rebootWorkspaces_rebootWorkspaceRequests' - The WorkSpaces to reboot. You can specify up to 25 WorkSpaces.
newRebootWorkspaces ::
  -- | 'rebootWorkspaceRequests'
  Prelude.NonEmpty RebootRequest ->
  RebootWorkspaces
newRebootWorkspaces :: NonEmpty RebootRequest -> RebootWorkspaces
newRebootWorkspaces NonEmpty RebootRequest
pRebootWorkspaceRequests_ =
  RebootWorkspaces'
    { $sel:rebootWorkspaceRequests:RebootWorkspaces' :: NonEmpty RebootRequest
rebootWorkspaceRequests =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty RebootRequest
pRebootWorkspaceRequests_
    }

-- | The WorkSpaces to reboot. You can specify up to 25 WorkSpaces.
rebootWorkspaces_rebootWorkspaceRequests :: Lens.Lens' RebootWorkspaces (Prelude.NonEmpty RebootRequest)
rebootWorkspaces_rebootWorkspaceRequests :: Lens' RebootWorkspaces (NonEmpty RebootRequest)
rebootWorkspaces_rebootWorkspaceRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootWorkspaces' {NonEmpty RebootRequest
rebootWorkspaceRequests :: NonEmpty RebootRequest
$sel:rebootWorkspaceRequests:RebootWorkspaces' :: RebootWorkspaces -> NonEmpty RebootRequest
rebootWorkspaceRequests} -> NonEmpty RebootRequest
rebootWorkspaceRequests) (\s :: RebootWorkspaces
s@RebootWorkspaces' {} NonEmpty RebootRequest
a -> RebootWorkspaces
s {$sel:rebootWorkspaceRequests:RebootWorkspaces' :: NonEmpty RebootRequest
rebootWorkspaceRequests = NonEmpty RebootRequest
a} :: RebootWorkspaces) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest RebootWorkspaces where
  type
    AWSResponse RebootWorkspaces =
      RebootWorkspacesResponse
  request :: (Service -> Service)
-> RebootWorkspaces -> Request RebootWorkspaces
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 RebootWorkspaces
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RebootWorkspaces)))
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 [FailedWorkspaceChangeRequest]
-> Int -> RebootWorkspacesResponse
RebootWorkspacesResponse'
            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
"FailedRequests" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 RebootWorkspaces where
  hashWithSalt :: Int -> RebootWorkspaces -> Int
hashWithSalt Int
_salt RebootWorkspaces' {NonEmpty RebootRequest
rebootWorkspaceRequests :: NonEmpty RebootRequest
$sel:rebootWorkspaceRequests:RebootWorkspaces' :: RebootWorkspaces -> NonEmpty RebootRequest
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty RebootRequest
rebootWorkspaceRequests

instance Prelude.NFData RebootWorkspaces where
  rnf :: RebootWorkspaces -> ()
rnf RebootWorkspaces' {NonEmpty RebootRequest
rebootWorkspaceRequests :: NonEmpty RebootRequest
$sel:rebootWorkspaceRequests:RebootWorkspaces' :: RebootWorkspaces -> NonEmpty RebootRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty RebootRequest
rebootWorkspaceRequests

instance Data.ToHeaders RebootWorkspaces where
  toHeaders :: RebootWorkspaces -> 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
"WorkspacesService.RebootWorkspaces" ::
                          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 RebootWorkspaces where
  toJSON :: RebootWorkspaces -> Value
toJSON RebootWorkspaces' {NonEmpty RebootRequest
rebootWorkspaceRequests :: NonEmpty RebootRequest
$sel:rebootWorkspaceRequests:RebootWorkspaces' :: RebootWorkspaces -> NonEmpty RebootRequest
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"RebootWorkspaceRequests"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty RebootRequest
rebootWorkspaceRequests
              )
          ]
      )

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

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

-- | /See:/ 'newRebootWorkspacesResponse' smart constructor.
data RebootWorkspacesResponse = RebootWorkspacesResponse'
  { -- | Information about the WorkSpaces that could not be rebooted.
    RebootWorkspacesResponse -> Maybe [FailedWorkspaceChangeRequest]
failedRequests :: Prelude.Maybe [FailedWorkspaceChangeRequest],
    -- | The response's http status code.
    RebootWorkspacesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RebootWorkspacesResponse -> RebootWorkspacesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootWorkspacesResponse -> RebootWorkspacesResponse -> Bool
$c/= :: RebootWorkspacesResponse -> RebootWorkspacesResponse -> Bool
== :: RebootWorkspacesResponse -> RebootWorkspacesResponse -> Bool
$c== :: RebootWorkspacesResponse -> RebootWorkspacesResponse -> Bool
Prelude.Eq, ReadPrec [RebootWorkspacesResponse]
ReadPrec RebootWorkspacesResponse
Int -> ReadS RebootWorkspacesResponse
ReadS [RebootWorkspacesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootWorkspacesResponse]
$creadListPrec :: ReadPrec [RebootWorkspacesResponse]
readPrec :: ReadPrec RebootWorkspacesResponse
$creadPrec :: ReadPrec RebootWorkspacesResponse
readList :: ReadS [RebootWorkspacesResponse]
$creadList :: ReadS [RebootWorkspacesResponse]
readsPrec :: Int -> ReadS RebootWorkspacesResponse
$creadsPrec :: Int -> ReadS RebootWorkspacesResponse
Prelude.Read, Int -> RebootWorkspacesResponse -> ShowS
[RebootWorkspacesResponse] -> ShowS
RebootWorkspacesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootWorkspacesResponse] -> ShowS
$cshowList :: [RebootWorkspacesResponse] -> ShowS
show :: RebootWorkspacesResponse -> String
$cshow :: RebootWorkspacesResponse -> String
showsPrec :: Int -> RebootWorkspacesResponse -> ShowS
$cshowsPrec :: Int -> RebootWorkspacesResponse -> ShowS
Prelude.Show, forall x.
Rep RebootWorkspacesResponse x -> RebootWorkspacesResponse
forall x.
RebootWorkspacesResponse -> Rep RebootWorkspacesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RebootWorkspacesResponse x -> RebootWorkspacesResponse
$cfrom :: forall x.
RebootWorkspacesResponse -> Rep RebootWorkspacesResponse x
Prelude.Generic)

-- |
-- Create a value of 'RebootWorkspacesResponse' 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:
--
-- 'failedRequests', 'rebootWorkspacesResponse_failedRequests' - Information about the WorkSpaces that could not be rebooted.
--
-- 'httpStatus', 'rebootWorkspacesResponse_httpStatus' - The response's http status code.
newRebootWorkspacesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RebootWorkspacesResponse
newRebootWorkspacesResponse :: Int -> RebootWorkspacesResponse
newRebootWorkspacesResponse Int
pHttpStatus_ =
  RebootWorkspacesResponse'
    { $sel:failedRequests:RebootWorkspacesResponse' :: Maybe [FailedWorkspaceChangeRequest]
failedRequests =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RebootWorkspacesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the WorkSpaces that could not be rebooted.
rebootWorkspacesResponse_failedRequests :: Lens.Lens' RebootWorkspacesResponse (Prelude.Maybe [FailedWorkspaceChangeRequest])
rebootWorkspacesResponse_failedRequests :: Lens'
  RebootWorkspacesResponse (Maybe [FailedWorkspaceChangeRequest])
rebootWorkspacesResponse_failedRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootWorkspacesResponse' {Maybe [FailedWorkspaceChangeRequest]
failedRequests :: Maybe [FailedWorkspaceChangeRequest]
$sel:failedRequests:RebootWorkspacesResponse' :: RebootWorkspacesResponse -> Maybe [FailedWorkspaceChangeRequest]
failedRequests} -> Maybe [FailedWorkspaceChangeRequest]
failedRequests) (\s :: RebootWorkspacesResponse
s@RebootWorkspacesResponse' {} Maybe [FailedWorkspaceChangeRequest]
a -> RebootWorkspacesResponse
s {$sel:failedRequests:RebootWorkspacesResponse' :: Maybe [FailedWorkspaceChangeRequest]
failedRequests = Maybe [FailedWorkspaceChangeRequest]
a} :: RebootWorkspacesResponse) 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

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

instance Prelude.NFData RebootWorkspacesResponse where
  rnf :: RebootWorkspacesResponse -> ()
rnf RebootWorkspacesResponse' {Int
Maybe [FailedWorkspaceChangeRequest]
httpStatus :: Int
failedRequests :: Maybe [FailedWorkspaceChangeRequest]
$sel:httpStatus:RebootWorkspacesResponse' :: RebootWorkspacesResponse -> Int
$sel:failedRequests:RebootWorkspacesResponse' :: RebootWorkspacesResponse -> Maybe [FailedWorkspaceChangeRequest]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedWorkspaceChangeRequest]
failedRequests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus