{-# 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.MigrateWorkspace
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Migrates a WorkSpace from one operating system or bundle type to
-- another, while retaining the data on the user volume.
--
-- The migration process recreates the WorkSpace by using a new root volume
-- from the target bundle image and the user volume from the last available
-- snapshot of the original WorkSpace. During migration, the original
-- @D:\\Users\\%USERNAME%@ user profile folder is renamed to
-- @D:\\Users\\%USERNAME%MMddyyTHHmmss%.NotMigrated@. A new
-- @D:\\Users\\%USERNAME%\\@ folder is generated by the new OS. Certain
-- files in the old user profile are moved to the new user profile.
--
-- For available migration scenarios, details about what happens during
-- migration, and best practices, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/migrate-workspaces.html Migrate a WorkSpace>.
module Amazonka.WorkSpaces.MigrateWorkspace
  ( -- * Creating a Request
    MigrateWorkspace (..),
    newMigrateWorkspace,

    -- * Request Lenses
    migrateWorkspace_sourceWorkspaceId,
    migrateWorkspace_bundleId,

    -- * Destructuring the Response
    MigrateWorkspaceResponse (..),
    newMigrateWorkspaceResponse,

    -- * Response Lenses
    migrateWorkspaceResponse_sourceWorkspaceId,
    migrateWorkspaceResponse_targetWorkspaceId,
    migrateWorkspaceResponse_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:/ 'newMigrateWorkspace' smart constructor.
data MigrateWorkspace = MigrateWorkspace'
  { -- | The identifier of the WorkSpace to migrate from.
    MigrateWorkspace -> Text
sourceWorkspaceId :: Prelude.Text,
    -- | The identifier of the target bundle type to migrate the WorkSpace to.
    MigrateWorkspace -> Text
bundleId :: Prelude.Text
  }
  deriving (MigrateWorkspace -> MigrateWorkspace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrateWorkspace -> MigrateWorkspace -> Bool
$c/= :: MigrateWorkspace -> MigrateWorkspace -> Bool
== :: MigrateWorkspace -> MigrateWorkspace -> Bool
$c== :: MigrateWorkspace -> MigrateWorkspace -> Bool
Prelude.Eq, ReadPrec [MigrateWorkspace]
ReadPrec MigrateWorkspace
Int -> ReadS MigrateWorkspace
ReadS [MigrateWorkspace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MigrateWorkspace]
$creadListPrec :: ReadPrec [MigrateWorkspace]
readPrec :: ReadPrec MigrateWorkspace
$creadPrec :: ReadPrec MigrateWorkspace
readList :: ReadS [MigrateWorkspace]
$creadList :: ReadS [MigrateWorkspace]
readsPrec :: Int -> ReadS MigrateWorkspace
$creadsPrec :: Int -> ReadS MigrateWorkspace
Prelude.Read, Int -> MigrateWorkspace -> ShowS
[MigrateWorkspace] -> ShowS
MigrateWorkspace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrateWorkspace] -> ShowS
$cshowList :: [MigrateWorkspace] -> ShowS
show :: MigrateWorkspace -> String
$cshow :: MigrateWorkspace -> String
showsPrec :: Int -> MigrateWorkspace -> ShowS
$cshowsPrec :: Int -> MigrateWorkspace -> ShowS
Prelude.Show, forall x. Rep MigrateWorkspace x -> MigrateWorkspace
forall x. MigrateWorkspace -> Rep MigrateWorkspace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MigrateWorkspace x -> MigrateWorkspace
$cfrom :: forall x. MigrateWorkspace -> Rep MigrateWorkspace x
Prelude.Generic)

-- |
-- Create a value of 'MigrateWorkspace' 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:
--
-- 'sourceWorkspaceId', 'migrateWorkspace_sourceWorkspaceId' - The identifier of the WorkSpace to migrate from.
--
-- 'bundleId', 'migrateWorkspace_bundleId' - The identifier of the target bundle type to migrate the WorkSpace to.
newMigrateWorkspace ::
  -- | 'sourceWorkspaceId'
  Prelude.Text ->
  -- | 'bundleId'
  Prelude.Text ->
  MigrateWorkspace
newMigrateWorkspace :: Text -> Text -> MigrateWorkspace
newMigrateWorkspace Text
pSourceWorkspaceId_ Text
pBundleId_ =
  MigrateWorkspace'
    { $sel:sourceWorkspaceId:MigrateWorkspace' :: Text
sourceWorkspaceId =
        Text
pSourceWorkspaceId_,
      $sel:bundleId:MigrateWorkspace' :: Text
bundleId = Text
pBundleId_
    }

-- | The identifier of the WorkSpace to migrate from.
migrateWorkspace_sourceWorkspaceId :: Lens.Lens' MigrateWorkspace Prelude.Text
migrateWorkspace_sourceWorkspaceId :: Lens' MigrateWorkspace Text
migrateWorkspace_sourceWorkspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MigrateWorkspace' {Text
sourceWorkspaceId :: Text
$sel:sourceWorkspaceId:MigrateWorkspace' :: MigrateWorkspace -> Text
sourceWorkspaceId} -> Text
sourceWorkspaceId) (\s :: MigrateWorkspace
s@MigrateWorkspace' {} Text
a -> MigrateWorkspace
s {$sel:sourceWorkspaceId:MigrateWorkspace' :: Text
sourceWorkspaceId = Text
a} :: MigrateWorkspace)

-- | The identifier of the target bundle type to migrate the WorkSpace to.
migrateWorkspace_bundleId :: Lens.Lens' MigrateWorkspace Prelude.Text
migrateWorkspace_bundleId :: Lens' MigrateWorkspace Text
migrateWorkspace_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MigrateWorkspace' {Text
bundleId :: Text
$sel:bundleId:MigrateWorkspace' :: MigrateWorkspace -> Text
bundleId} -> Text
bundleId) (\s :: MigrateWorkspace
s@MigrateWorkspace' {} Text
a -> MigrateWorkspace
s {$sel:bundleId:MigrateWorkspace' :: Text
bundleId = Text
a} :: MigrateWorkspace)

instance Core.AWSRequest MigrateWorkspace where
  type
    AWSResponse MigrateWorkspace =
      MigrateWorkspaceResponse
  request :: (Service -> Service)
-> MigrateWorkspace -> Request MigrateWorkspace
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 MigrateWorkspace
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MigrateWorkspace)))
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 Text -> Int -> MigrateWorkspaceResponse
MigrateWorkspaceResponse'
            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
"SourceWorkspaceId")
            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
"TargetWorkspaceId")
            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 MigrateWorkspace where
  hashWithSalt :: Int -> MigrateWorkspace -> Int
hashWithSalt Int
_salt MigrateWorkspace' {Text
bundleId :: Text
sourceWorkspaceId :: Text
$sel:bundleId:MigrateWorkspace' :: MigrateWorkspace -> Text
$sel:sourceWorkspaceId:MigrateWorkspace' :: MigrateWorkspace -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceWorkspaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleId

instance Prelude.NFData MigrateWorkspace where
  rnf :: MigrateWorkspace -> ()
rnf MigrateWorkspace' {Text
bundleId :: Text
sourceWorkspaceId :: Text
$sel:bundleId:MigrateWorkspace' :: MigrateWorkspace -> Text
$sel:sourceWorkspaceId:MigrateWorkspace' :: MigrateWorkspace -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
sourceWorkspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bundleId

instance Data.ToHeaders MigrateWorkspace where
  toHeaders :: MigrateWorkspace -> 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.MigrateWorkspace" ::
                          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 MigrateWorkspace where
  toJSON :: MigrateWorkspace -> Value
toJSON MigrateWorkspace' {Text
bundleId :: Text
sourceWorkspaceId :: Text
$sel:bundleId:MigrateWorkspace' :: MigrateWorkspace -> Text
$sel:sourceWorkspaceId:MigrateWorkspace' :: MigrateWorkspace -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceWorkspaceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceWorkspaceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"BundleId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
bundleId)
          ]
      )

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

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

-- | /See:/ 'newMigrateWorkspaceResponse' smart constructor.
data MigrateWorkspaceResponse = MigrateWorkspaceResponse'
  { -- | The original identifier of the WorkSpace that is being migrated.
    MigrateWorkspaceResponse -> Maybe Text
sourceWorkspaceId :: Prelude.Maybe Prelude.Text,
    -- | The new identifier of the WorkSpace that is being migrated. If the
    -- migration does not succeed, the target WorkSpace ID will not be used,
    -- and the WorkSpace will still have the original WorkSpace ID.
    MigrateWorkspaceResponse -> Maybe Text
targetWorkspaceId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    MigrateWorkspaceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (MigrateWorkspaceResponse -> MigrateWorkspaceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrateWorkspaceResponse -> MigrateWorkspaceResponse -> Bool
$c/= :: MigrateWorkspaceResponse -> MigrateWorkspaceResponse -> Bool
== :: MigrateWorkspaceResponse -> MigrateWorkspaceResponse -> Bool
$c== :: MigrateWorkspaceResponse -> MigrateWorkspaceResponse -> Bool
Prelude.Eq, ReadPrec [MigrateWorkspaceResponse]
ReadPrec MigrateWorkspaceResponse
Int -> ReadS MigrateWorkspaceResponse
ReadS [MigrateWorkspaceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MigrateWorkspaceResponse]
$creadListPrec :: ReadPrec [MigrateWorkspaceResponse]
readPrec :: ReadPrec MigrateWorkspaceResponse
$creadPrec :: ReadPrec MigrateWorkspaceResponse
readList :: ReadS [MigrateWorkspaceResponse]
$creadList :: ReadS [MigrateWorkspaceResponse]
readsPrec :: Int -> ReadS MigrateWorkspaceResponse
$creadsPrec :: Int -> ReadS MigrateWorkspaceResponse
Prelude.Read, Int -> MigrateWorkspaceResponse -> ShowS
[MigrateWorkspaceResponse] -> ShowS
MigrateWorkspaceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrateWorkspaceResponse] -> ShowS
$cshowList :: [MigrateWorkspaceResponse] -> ShowS
show :: MigrateWorkspaceResponse -> String
$cshow :: MigrateWorkspaceResponse -> String
showsPrec :: Int -> MigrateWorkspaceResponse -> ShowS
$cshowsPrec :: Int -> MigrateWorkspaceResponse -> ShowS
Prelude.Show, forall x.
Rep MigrateWorkspaceResponse x -> MigrateWorkspaceResponse
forall x.
MigrateWorkspaceResponse -> Rep MigrateWorkspaceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MigrateWorkspaceResponse x -> MigrateWorkspaceResponse
$cfrom :: forall x.
MigrateWorkspaceResponse -> Rep MigrateWorkspaceResponse x
Prelude.Generic)

-- |
-- Create a value of 'MigrateWorkspaceResponse' 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:
--
-- 'sourceWorkspaceId', 'migrateWorkspaceResponse_sourceWorkspaceId' - The original identifier of the WorkSpace that is being migrated.
--
-- 'targetWorkspaceId', 'migrateWorkspaceResponse_targetWorkspaceId' - The new identifier of the WorkSpace that is being migrated. If the
-- migration does not succeed, the target WorkSpace ID will not be used,
-- and the WorkSpace will still have the original WorkSpace ID.
--
-- 'httpStatus', 'migrateWorkspaceResponse_httpStatus' - The response's http status code.
newMigrateWorkspaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MigrateWorkspaceResponse
newMigrateWorkspaceResponse :: Int -> MigrateWorkspaceResponse
newMigrateWorkspaceResponse Int
pHttpStatus_ =
  MigrateWorkspaceResponse'
    { $sel:sourceWorkspaceId:MigrateWorkspaceResponse' :: Maybe Text
sourceWorkspaceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:targetWorkspaceId:MigrateWorkspaceResponse' :: Maybe Text
targetWorkspaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MigrateWorkspaceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The original identifier of the WorkSpace that is being migrated.
migrateWorkspaceResponse_sourceWorkspaceId :: Lens.Lens' MigrateWorkspaceResponse (Prelude.Maybe Prelude.Text)
migrateWorkspaceResponse_sourceWorkspaceId :: Lens' MigrateWorkspaceResponse (Maybe Text)
migrateWorkspaceResponse_sourceWorkspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MigrateWorkspaceResponse' {Maybe Text
sourceWorkspaceId :: Maybe Text
$sel:sourceWorkspaceId:MigrateWorkspaceResponse' :: MigrateWorkspaceResponse -> Maybe Text
sourceWorkspaceId} -> Maybe Text
sourceWorkspaceId) (\s :: MigrateWorkspaceResponse
s@MigrateWorkspaceResponse' {} Maybe Text
a -> MigrateWorkspaceResponse
s {$sel:sourceWorkspaceId:MigrateWorkspaceResponse' :: Maybe Text
sourceWorkspaceId = Maybe Text
a} :: MigrateWorkspaceResponse)

-- | The new identifier of the WorkSpace that is being migrated. If the
-- migration does not succeed, the target WorkSpace ID will not be used,
-- and the WorkSpace will still have the original WorkSpace ID.
migrateWorkspaceResponse_targetWorkspaceId :: Lens.Lens' MigrateWorkspaceResponse (Prelude.Maybe Prelude.Text)
migrateWorkspaceResponse_targetWorkspaceId :: Lens' MigrateWorkspaceResponse (Maybe Text)
migrateWorkspaceResponse_targetWorkspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MigrateWorkspaceResponse' {Maybe Text
targetWorkspaceId :: Maybe Text
$sel:targetWorkspaceId:MigrateWorkspaceResponse' :: MigrateWorkspaceResponse -> Maybe Text
targetWorkspaceId} -> Maybe Text
targetWorkspaceId) (\s :: MigrateWorkspaceResponse
s@MigrateWorkspaceResponse' {} Maybe Text
a -> MigrateWorkspaceResponse
s {$sel:targetWorkspaceId:MigrateWorkspaceResponse' :: Maybe Text
targetWorkspaceId = Maybe Text
a} :: MigrateWorkspaceResponse)

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

instance Prelude.NFData MigrateWorkspaceResponse where
  rnf :: MigrateWorkspaceResponse -> ()
rnf MigrateWorkspaceResponse' {Int
Maybe Text
httpStatus :: Int
targetWorkspaceId :: Maybe Text
sourceWorkspaceId :: Maybe Text
$sel:httpStatus:MigrateWorkspaceResponse' :: MigrateWorkspaceResponse -> Int
$sel:targetWorkspaceId:MigrateWorkspaceResponse' :: MigrateWorkspaceResponse -> Maybe Text
$sel:sourceWorkspaceId:MigrateWorkspaceResponse' :: MigrateWorkspaceResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceWorkspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetWorkspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus