{-# 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.DescribeWorkspaces
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified WorkSpaces.
--
-- You can filter the results by using the bundle identifier, directory
-- identifier, or owner, but you can specify only one filter at a time.
--
-- This operation returns paginated results.
module Amazonka.WorkSpaces.DescribeWorkspaces
  ( -- * Creating a Request
    DescribeWorkspaces (..),
    newDescribeWorkspaces,

    -- * Request Lenses
    describeWorkspaces_bundleId,
    describeWorkspaces_directoryId,
    describeWorkspaces_limit,
    describeWorkspaces_nextToken,
    describeWorkspaces_userName,
    describeWorkspaces_workspaceIds,

    -- * Destructuring the Response
    DescribeWorkspacesResponse (..),
    newDescribeWorkspacesResponse,

    -- * Response Lenses
    describeWorkspacesResponse_nextToken,
    describeWorkspacesResponse_workspaces,
    describeWorkspacesResponse_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:/ 'newDescribeWorkspaces' smart constructor.
data DescribeWorkspaces = DescribeWorkspaces'
  { -- | The identifier of the bundle. All WorkSpaces that are created from this
    -- bundle are retrieved. You cannot combine this parameter with any other
    -- filter.
    DescribeWorkspaces -> Maybe Text
bundleId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the directory. In addition, you can optionally specify
    -- a specific directory user (see @UserName@). You cannot combine this
    -- parameter with any other filter.
    DescribeWorkspaces -> Maybe Text
directoryId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of items to return.
    DescribeWorkspaces -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | If you received a @NextToken@ from a previous call that was paginated,
    -- provide this token to receive the next set of results.
    DescribeWorkspaces -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the directory user. You must specify this parameter with
    -- @DirectoryId@.
    DescribeWorkspaces -> Maybe Text
userName :: Prelude.Maybe Prelude.Text,
    -- | The identifiers of the WorkSpaces. You cannot combine this parameter
    -- with any other filter.
    --
    -- Because the CreateWorkspaces operation is asynchronous, the identifier
    -- it returns is not immediately available. If you immediately call
    -- DescribeWorkspaces with this identifier, no information is returned.
    DescribeWorkspaces -> Maybe (NonEmpty Text)
workspaceIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text)
  }
  deriving (DescribeWorkspaces -> DescribeWorkspaces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorkspaces -> DescribeWorkspaces -> Bool
$c/= :: DescribeWorkspaces -> DescribeWorkspaces -> Bool
== :: DescribeWorkspaces -> DescribeWorkspaces -> Bool
$c== :: DescribeWorkspaces -> DescribeWorkspaces -> Bool
Prelude.Eq, ReadPrec [DescribeWorkspaces]
ReadPrec DescribeWorkspaces
Int -> ReadS DescribeWorkspaces
ReadS [DescribeWorkspaces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorkspaces]
$creadListPrec :: ReadPrec [DescribeWorkspaces]
readPrec :: ReadPrec DescribeWorkspaces
$creadPrec :: ReadPrec DescribeWorkspaces
readList :: ReadS [DescribeWorkspaces]
$creadList :: ReadS [DescribeWorkspaces]
readsPrec :: Int -> ReadS DescribeWorkspaces
$creadsPrec :: Int -> ReadS DescribeWorkspaces
Prelude.Read, Int -> DescribeWorkspaces -> ShowS
[DescribeWorkspaces] -> ShowS
DescribeWorkspaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorkspaces] -> ShowS
$cshowList :: [DescribeWorkspaces] -> ShowS
show :: DescribeWorkspaces -> String
$cshow :: DescribeWorkspaces -> String
showsPrec :: Int -> DescribeWorkspaces -> ShowS
$cshowsPrec :: Int -> DescribeWorkspaces -> ShowS
Prelude.Show, forall x. Rep DescribeWorkspaces x -> DescribeWorkspaces
forall x. DescribeWorkspaces -> Rep DescribeWorkspaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWorkspaces x -> DescribeWorkspaces
$cfrom :: forall x. DescribeWorkspaces -> Rep DescribeWorkspaces x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorkspaces' 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', 'describeWorkspaces_bundleId' - The identifier of the bundle. All WorkSpaces that are created from this
-- bundle are retrieved. You cannot combine this parameter with any other
-- filter.
--
-- 'directoryId', 'describeWorkspaces_directoryId' - The identifier of the directory. In addition, you can optionally specify
-- a specific directory user (see @UserName@). You cannot combine this
-- parameter with any other filter.
--
-- 'limit', 'describeWorkspaces_limit' - The maximum number of items to return.
--
-- 'nextToken', 'describeWorkspaces_nextToken' - If you received a @NextToken@ from a previous call that was paginated,
-- provide this token to receive the next set of results.
--
-- 'userName', 'describeWorkspaces_userName' - The name of the directory user. You must specify this parameter with
-- @DirectoryId@.
--
-- 'workspaceIds', 'describeWorkspaces_workspaceIds' - The identifiers of the WorkSpaces. You cannot combine this parameter
-- with any other filter.
--
-- Because the CreateWorkspaces operation is asynchronous, the identifier
-- it returns is not immediately available. If you immediately call
-- DescribeWorkspaces with this identifier, no information is returned.
newDescribeWorkspaces ::
  DescribeWorkspaces
newDescribeWorkspaces :: DescribeWorkspaces
newDescribeWorkspaces =
  DescribeWorkspaces'
    { $sel:bundleId:DescribeWorkspaces' :: Maybe Text
bundleId = forall a. Maybe a
Prelude.Nothing,
      $sel:directoryId:DescribeWorkspaces' :: Maybe Text
directoryId = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:DescribeWorkspaces' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeWorkspaces' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:DescribeWorkspaces' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing,
      $sel:workspaceIds:DescribeWorkspaces' :: Maybe (NonEmpty Text)
workspaceIds = forall a. Maybe a
Prelude.Nothing
    }

-- | The identifier of the bundle. All WorkSpaces that are created from this
-- bundle are retrieved. You cannot combine this parameter with any other
-- filter.
describeWorkspaces_bundleId :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe Prelude.Text)
describeWorkspaces_bundleId :: Lens' DescribeWorkspaces (Maybe Text)
describeWorkspaces_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe Text
bundleId :: Maybe Text
$sel:bundleId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
bundleId} -> Maybe Text
bundleId) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe Text
a -> DescribeWorkspaces
s {$sel:bundleId:DescribeWorkspaces' :: Maybe Text
bundleId = Maybe Text
a} :: DescribeWorkspaces)

-- | The identifier of the directory. In addition, you can optionally specify
-- a specific directory user (see @UserName@). You cannot combine this
-- parameter with any other filter.
describeWorkspaces_directoryId :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe Prelude.Text)
describeWorkspaces_directoryId :: Lens' DescribeWorkspaces (Maybe Text)
describeWorkspaces_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe Text
directoryId :: Maybe Text
$sel:directoryId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
directoryId} -> Maybe Text
directoryId) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe Text
a -> DescribeWorkspaces
s {$sel:directoryId:DescribeWorkspaces' :: Maybe Text
directoryId = Maybe Text
a} :: DescribeWorkspaces)

-- | The maximum number of items to return.
describeWorkspaces_limit :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe Prelude.Natural)
describeWorkspaces_limit :: Lens' DescribeWorkspaces (Maybe Natural)
describeWorkspaces_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe Natural
limit :: Maybe Natural
$sel:limit:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe Natural
a -> DescribeWorkspaces
s {$sel:limit:DescribeWorkspaces' :: Maybe Natural
limit = Maybe Natural
a} :: DescribeWorkspaces)

-- | If you received a @NextToken@ from a previous call that was paginated,
-- provide this token to receive the next set of results.
describeWorkspaces_nextToken :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe Prelude.Text)
describeWorkspaces_nextToken :: Lens' DescribeWorkspaces (Maybe Text)
describeWorkspaces_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe Text
a -> DescribeWorkspaces
s {$sel:nextToken:DescribeWorkspaces' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeWorkspaces)

-- | The name of the directory user. You must specify this parameter with
-- @DirectoryId@.
describeWorkspaces_userName :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe Prelude.Text)
describeWorkspaces_userName :: Lens' DescribeWorkspaces (Maybe Text)
describeWorkspaces_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe Text
userName :: Maybe Text
$sel:userName:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
userName} -> Maybe Text
userName) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe Text
a -> DescribeWorkspaces
s {$sel:userName:DescribeWorkspaces' :: Maybe Text
userName = Maybe Text
a} :: DescribeWorkspaces)

-- | The identifiers of the WorkSpaces. You cannot combine this parameter
-- with any other filter.
--
-- Because the CreateWorkspaces operation is asynchronous, the identifier
-- it returns is not immediately available. If you immediately call
-- DescribeWorkspaces with this identifier, no information is returned.
describeWorkspaces_workspaceIds :: Lens.Lens' DescribeWorkspaces (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describeWorkspaces_workspaceIds :: Lens' DescribeWorkspaces (Maybe (NonEmpty Text))
describeWorkspaces_workspaceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspaces' {Maybe (NonEmpty Text)
workspaceIds :: Maybe (NonEmpty Text)
$sel:workspaceIds:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe (NonEmpty Text)
workspaceIds} -> Maybe (NonEmpty Text)
workspaceIds) (\s :: DescribeWorkspaces
s@DescribeWorkspaces' {} Maybe (NonEmpty Text)
a -> DescribeWorkspaces
s {$sel:workspaceIds:DescribeWorkspaces' :: Maybe (NonEmpty Text)
workspaceIds = Maybe (NonEmpty Text)
a} :: DescribeWorkspaces) 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

instance Core.AWSPager DescribeWorkspaces where
  page :: DescribeWorkspaces
-> AWSResponse DescribeWorkspaces -> Maybe DescribeWorkspaces
page DescribeWorkspaces
rq AWSResponse DescribeWorkspaces
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeWorkspaces
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeWorkspacesResponse (Maybe Text)
describeWorkspacesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeWorkspaces
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeWorkspacesResponse (Maybe [Workspace])
describeWorkspacesResponse_workspaces
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeWorkspaces
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeWorkspaces (Maybe Text)
describeWorkspaces_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeWorkspaces
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeWorkspacesResponse (Maybe Text)
describeWorkspacesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeWorkspaces where
  type
    AWSResponse DescribeWorkspaces =
      DescribeWorkspacesResponse
  request :: (Service -> Service)
-> DescribeWorkspaces -> Request DescribeWorkspaces
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 DescribeWorkspaces
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeWorkspaces)))
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
-> Maybe [Workspace] -> Int -> DescribeWorkspacesResponse
DescribeWorkspacesResponse'
            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
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Workspaces" 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 DescribeWorkspaces where
  hashWithSalt :: Int -> DescribeWorkspaces -> Int
hashWithSalt Int
_salt DescribeWorkspaces' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
workspaceIds :: Maybe (NonEmpty Text)
userName :: Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
directoryId :: Maybe Text
bundleId :: Maybe Text
$sel:workspaceIds:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe (NonEmpty Text)
$sel:userName:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:nextToken:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:limit:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Natural
$sel:directoryId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:bundleId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bundleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
workspaceIds

instance Prelude.NFData DescribeWorkspaces where
  rnf :: DescribeWorkspaces -> ()
rnf DescribeWorkspaces' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
workspaceIds :: Maybe (NonEmpty Text)
userName :: Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
directoryId :: Maybe Text
bundleId :: Maybe Text
$sel:workspaceIds:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe (NonEmpty Text)
$sel:userName:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:nextToken:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:limit:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Natural
$sel:directoryId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:bundleId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bundleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
workspaceIds

instance Data.ToHeaders DescribeWorkspaces where
  toHeaders :: DescribeWorkspaces -> 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.DescribeWorkspaces" ::
                          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 DescribeWorkspaces where
  toJSON :: DescribeWorkspaces -> Value
toJSON DescribeWorkspaces' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
workspaceIds :: Maybe (NonEmpty Text)
userName :: Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
directoryId :: Maybe Text
bundleId :: Maybe Text
$sel:workspaceIds:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe (NonEmpty Text)
$sel:userName:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:nextToken:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:limit:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Natural
$sel:directoryId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
$sel:bundleId:DescribeWorkspaces' :: DescribeWorkspaces -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BundleId" 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
bundleId,
            (Key
"DirectoryId" 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
directoryId,
            (Key
"Limit" 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 Natural
limit,
            (Key
"NextToken" 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
nextToken,
            (Key
"UserName" 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
userName,
            (Key
"WorkspaceIds" 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 (NonEmpty Text)
workspaceIds
          ]
      )

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

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

-- | /See:/ 'newDescribeWorkspacesResponse' smart constructor.
data DescribeWorkspacesResponse = DescribeWorkspacesResponse'
  { -- | The token to use to retrieve the next page of results. This value is
    -- null when there are no more results to return.
    DescribeWorkspacesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the WorkSpaces.
    --
    -- Because CreateWorkspaces is an asynchronous operation, some of the
    -- returned information could be incomplete.
    DescribeWorkspacesResponse -> Maybe [Workspace]
workspaces :: Prelude.Maybe [Workspace],
    -- | The response's http status code.
    DescribeWorkspacesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeWorkspacesResponse -> DescribeWorkspacesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorkspacesResponse -> DescribeWorkspacesResponse -> Bool
$c/= :: DescribeWorkspacesResponse -> DescribeWorkspacesResponse -> Bool
== :: DescribeWorkspacesResponse -> DescribeWorkspacesResponse -> Bool
$c== :: DescribeWorkspacesResponse -> DescribeWorkspacesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeWorkspacesResponse]
ReadPrec DescribeWorkspacesResponse
Int -> ReadS DescribeWorkspacesResponse
ReadS [DescribeWorkspacesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorkspacesResponse]
$creadListPrec :: ReadPrec [DescribeWorkspacesResponse]
readPrec :: ReadPrec DescribeWorkspacesResponse
$creadPrec :: ReadPrec DescribeWorkspacesResponse
readList :: ReadS [DescribeWorkspacesResponse]
$creadList :: ReadS [DescribeWorkspacesResponse]
readsPrec :: Int -> ReadS DescribeWorkspacesResponse
$creadsPrec :: Int -> ReadS DescribeWorkspacesResponse
Prelude.Read, Int -> DescribeWorkspacesResponse -> ShowS
[DescribeWorkspacesResponse] -> ShowS
DescribeWorkspacesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorkspacesResponse] -> ShowS
$cshowList :: [DescribeWorkspacesResponse] -> ShowS
show :: DescribeWorkspacesResponse -> String
$cshow :: DescribeWorkspacesResponse -> String
showsPrec :: Int -> DescribeWorkspacesResponse -> ShowS
$cshowsPrec :: Int -> DescribeWorkspacesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeWorkspacesResponse x -> DescribeWorkspacesResponse
forall x.
DescribeWorkspacesResponse -> Rep DescribeWorkspacesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeWorkspacesResponse x -> DescribeWorkspacesResponse
$cfrom :: forall x.
DescribeWorkspacesResponse -> Rep DescribeWorkspacesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorkspacesResponse' 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:
--
-- 'nextToken', 'describeWorkspacesResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- null when there are no more results to return.
--
-- 'workspaces', 'describeWorkspacesResponse_workspaces' - Information about the WorkSpaces.
--
-- Because CreateWorkspaces is an asynchronous operation, some of the
-- returned information could be incomplete.
--
-- 'httpStatus', 'describeWorkspacesResponse_httpStatus' - The response's http status code.
newDescribeWorkspacesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeWorkspacesResponse
newDescribeWorkspacesResponse :: Int -> DescribeWorkspacesResponse
newDescribeWorkspacesResponse Int
pHttpStatus_ =
  DescribeWorkspacesResponse'
    { $sel:nextToken:DescribeWorkspacesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workspaces:DescribeWorkspacesResponse' :: Maybe [Workspace]
workspaces = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeWorkspacesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to use to retrieve the next page of results. This value is
-- null when there are no more results to return.
describeWorkspacesResponse_nextToken :: Lens.Lens' DescribeWorkspacesResponse (Prelude.Maybe Prelude.Text)
describeWorkspacesResponse_nextToken :: Lens' DescribeWorkspacesResponse (Maybe Text)
describeWorkspacesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspacesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeWorkspacesResponse
s@DescribeWorkspacesResponse' {} Maybe Text
a -> DescribeWorkspacesResponse
s {$sel:nextToken:DescribeWorkspacesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeWorkspacesResponse)

-- | Information about the WorkSpaces.
--
-- Because CreateWorkspaces is an asynchronous operation, some of the
-- returned information could be incomplete.
describeWorkspacesResponse_workspaces :: Lens.Lens' DescribeWorkspacesResponse (Prelude.Maybe [Workspace])
describeWorkspacesResponse_workspaces :: Lens' DescribeWorkspacesResponse (Maybe [Workspace])
describeWorkspacesResponse_workspaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspacesResponse' {Maybe [Workspace]
workspaces :: Maybe [Workspace]
$sel:workspaces:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Maybe [Workspace]
workspaces} -> Maybe [Workspace]
workspaces) (\s :: DescribeWorkspacesResponse
s@DescribeWorkspacesResponse' {} Maybe [Workspace]
a -> DescribeWorkspacesResponse
s {$sel:workspaces:DescribeWorkspacesResponse' :: Maybe [Workspace]
workspaces = Maybe [Workspace]
a} :: DescribeWorkspacesResponse) 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.
describeWorkspacesResponse_httpStatus :: Lens.Lens' DescribeWorkspacesResponse Prelude.Int
describeWorkspacesResponse_httpStatus :: Lens' DescribeWorkspacesResponse Int
describeWorkspacesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkspacesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeWorkspacesResponse
s@DescribeWorkspacesResponse' {} Int
a -> DescribeWorkspacesResponse
s {$sel:httpStatus:DescribeWorkspacesResponse' :: Int
httpStatus = Int
a} :: DescribeWorkspacesResponse)

instance Prelude.NFData DescribeWorkspacesResponse where
  rnf :: DescribeWorkspacesResponse -> ()
rnf DescribeWorkspacesResponse' {Int
Maybe [Workspace]
Maybe Text
httpStatus :: Int
workspaces :: Maybe [Workspace]
nextToken :: Maybe Text
$sel:httpStatus:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Int
$sel:workspaces:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Maybe [Workspace]
$sel:nextToken:DescribeWorkspacesResponse' :: DescribeWorkspacesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Workspace]
workspaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus