{-# 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.Organizations.MoveAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Moves an account from its current source parent root or organizational
-- unit (OU) to the specified destination parent root or OU.
--
-- This operation can be called only from the organization\'s management
-- account.
module Amazonka.Organizations.MoveAccount
  ( -- * Creating a Request
    MoveAccount (..),
    newMoveAccount,

    -- * Request Lenses
    moveAccount_accountId,
    moveAccount_sourceParentId,
    moveAccount_destinationParentId,

    -- * Destructuring the Response
    MoveAccountResponse (..),
    newMoveAccountResponse,
  )
where

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

-- | /See:/ 'newMoveAccount' smart constructor.
data MoveAccount = MoveAccount'
  { -- | The unique identifier (ID) of the account that you want to move.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
    -- string requires exactly 12 digits.
    MoveAccount -> Text
accountId :: Prelude.Text,
    -- | The unique identifier (ID) of the root or organizational unit that you
    -- want to move the account from.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
    -- string requires one of the following:
    --
    -- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
    --     lowercase letters or digits.
    --
    -- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
    --     followed by from 4 to 32 lowercase letters or digits (the ID of the
    --     root that the OU is in). This string is followed by a second \"-\"
    --     dash and from 8 to 32 additional lowercase letters or digits.
    MoveAccount -> Text
sourceParentId :: Prelude.Text,
    -- | The unique identifier (ID) of the root or organizational unit that you
    -- want to move the account to.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
    -- string requires one of the following:
    --
    -- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
    --     lowercase letters or digits.
    --
    -- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
    --     followed by from 4 to 32 lowercase letters or digits (the ID of the
    --     root that the OU is in). This string is followed by a second \"-\"
    --     dash and from 8 to 32 additional lowercase letters or digits.
    MoveAccount -> Text
destinationParentId :: Prelude.Text
  }
  deriving (MoveAccount -> MoveAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoveAccount -> MoveAccount -> Bool
$c/= :: MoveAccount -> MoveAccount -> Bool
== :: MoveAccount -> MoveAccount -> Bool
$c== :: MoveAccount -> MoveAccount -> Bool
Prelude.Eq, ReadPrec [MoveAccount]
ReadPrec MoveAccount
Int -> ReadS MoveAccount
ReadS [MoveAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MoveAccount]
$creadListPrec :: ReadPrec [MoveAccount]
readPrec :: ReadPrec MoveAccount
$creadPrec :: ReadPrec MoveAccount
readList :: ReadS [MoveAccount]
$creadList :: ReadS [MoveAccount]
readsPrec :: Int -> ReadS MoveAccount
$creadsPrec :: Int -> ReadS MoveAccount
Prelude.Read, Int -> MoveAccount -> ShowS
[MoveAccount] -> ShowS
MoveAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoveAccount] -> ShowS
$cshowList :: [MoveAccount] -> ShowS
show :: MoveAccount -> String
$cshow :: MoveAccount -> String
showsPrec :: Int -> MoveAccount -> ShowS
$cshowsPrec :: Int -> MoveAccount -> ShowS
Prelude.Show, forall x. Rep MoveAccount x -> MoveAccount
forall x. MoveAccount -> Rep MoveAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MoveAccount x -> MoveAccount
$cfrom :: forall x. MoveAccount -> Rep MoveAccount x
Prelude.Generic)

-- |
-- Create a value of 'MoveAccount' 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:
--
-- 'accountId', 'moveAccount_accountId' - The unique identifier (ID) of the account that you want to move.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
--
-- 'sourceParentId', 'moveAccount_sourceParentId' - The unique identifier (ID) of the root or organizational unit that you
-- want to move the account from.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
-- string requires one of the following:
--
-- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
--     lowercase letters or digits.
--
-- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
--     followed by from 4 to 32 lowercase letters or digits (the ID of the
--     root that the OU is in). This string is followed by a second \"-\"
--     dash and from 8 to 32 additional lowercase letters or digits.
--
-- 'destinationParentId', 'moveAccount_destinationParentId' - The unique identifier (ID) of the root or organizational unit that you
-- want to move the account to.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
-- string requires one of the following:
--
-- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
--     lowercase letters or digits.
--
-- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
--     followed by from 4 to 32 lowercase letters or digits (the ID of the
--     root that the OU is in). This string is followed by a second \"-\"
--     dash and from 8 to 32 additional lowercase letters or digits.
newMoveAccount ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'sourceParentId'
  Prelude.Text ->
  -- | 'destinationParentId'
  Prelude.Text ->
  MoveAccount
newMoveAccount :: Text -> Text -> Text -> MoveAccount
newMoveAccount
  Text
pAccountId_
  Text
pSourceParentId_
  Text
pDestinationParentId_ =
    MoveAccount'
      { $sel:accountId:MoveAccount' :: Text
accountId = Text
pAccountId_,
        $sel:sourceParentId:MoveAccount' :: Text
sourceParentId = Text
pSourceParentId_,
        $sel:destinationParentId:MoveAccount' :: Text
destinationParentId = Text
pDestinationParentId_
      }

-- | The unique identifier (ID) of the account that you want to move.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
moveAccount_accountId :: Lens.Lens' MoveAccount Prelude.Text
moveAccount_accountId :: Lens' MoveAccount Text
moveAccount_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MoveAccount' {Text
accountId :: Text
$sel:accountId:MoveAccount' :: MoveAccount -> Text
accountId} -> Text
accountId) (\s :: MoveAccount
s@MoveAccount' {} Text
a -> MoveAccount
s {$sel:accountId:MoveAccount' :: Text
accountId = Text
a} :: MoveAccount)

-- | The unique identifier (ID) of the root or organizational unit that you
-- want to move the account from.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
-- string requires one of the following:
--
-- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
--     lowercase letters or digits.
--
-- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
--     followed by from 4 to 32 lowercase letters or digits (the ID of the
--     root that the OU is in). This string is followed by a second \"-\"
--     dash and from 8 to 32 additional lowercase letters or digits.
moveAccount_sourceParentId :: Lens.Lens' MoveAccount Prelude.Text
moveAccount_sourceParentId :: Lens' MoveAccount Text
moveAccount_sourceParentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MoveAccount' {Text
sourceParentId :: Text
$sel:sourceParentId:MoveAccount' :: MoveAccount -> Text
sourceParentId} -> Text
sourceParentId) (\s :: MoveAccount
s@MoveAccount' {} Text
a -> MoveAccount
s {$sel:sourceParentId:MoveAccount' :: Text
sourceParentId = Text
a} :: MoveAccount)

-- | The unique identifier (ID) of the root or organizational unit that you
-- want to move the account to.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a parent ID
-- string requires one of the following:
--
-- -   __Root__ - A string that begins with \"r-\" followed by from 4 to 32
--     lowercase letters or digits.
--
-- -   __Organizational unit (OU)__ - A string that begins with \"ou-\"
--     followed by from 4 to 32 lowercase letters or digits (the ID of the
--     root that the OU is in). This string is followed by a second \"-\"
--     dash and from 8 to 32 additional lowercase letters or digits.
moveAccount_destinationParentId :: Lens.Lens' MoveAccount Prelude.Text
moveAccount_destinationParentId :: Lens' MoveAccount Text
moveAccount_destinationParentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MoveAccount' {Text
destinationParentId :: Text
$sel:destinationParentId:MoveAccount' :: MoveAccount -> Text
destinationParentId} -> Text
destinationParentId) (\s :: MoveAccount
s@MoveAccount' {} Text
a -> MoveAccount
s {$sel:destinationParentId:MoveAccount' :: Text
destinationParentId = Text
a} :: MoveAccount)

instance Core.AWSRequest MoveAccount where
  type AWSResponse MoveAccount = MoveAccountResponse
  request :: (Service -> Service) -> MoveAccount -> Request MoveAccount
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 MoveAccount
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MoveAccount)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull MoveAccountResponse
MoveAccountResponse'

instance Prelude.Hashable MoveAccount where
  hashWithSalt :: Int -> MoveAccount -> Int
hashWithSalt Int
_salt MoveAccount' {Text
destinationParentId :: Text
sourceParentId :: Text
accountId :: Text
$sel:destinationParentId:MoveAccount' :: MoveAccount -> Text
$sel:sourceParentId:MoveAccount' :: MoveAccount -> Text
$sel:accountId:MoveAccount' :: MoveAccount -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceParentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationParentId

instance Prelude.NFData MoveAccount where
  rnf :: MoveAccount -> ()
rnf MoveAccount' {Text
destinationParentId :: Text
sourceParentId :: Text
accountId :: Text
$sel:destinationParentId:MoveAccount' :: MoveAccount -> Text
$sel:sourceParentId:MoveAccount' :: MoveAccount -> Text
$sel:accountId:MoveAccount' :: MoveAccount -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceParentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationParentId

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

instance Data.ToJSON MoveAccount where
  toJSON :: MoveAccount -> Value
toJSON MoveAccount' {Text
destinationParentId :: Text
sourceParentId :: Text
accountId :: Text
$sel:destinationParentId:MoveAccount' :: MoveAccount -> Text
$sel:sourceParentId:MoveAccount' :: MoveAccount -> Text
$sel:accountId:MoveAccount' :: MoveAccount -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"AccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
accountId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceParentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceParentId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationParentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationParentId)
          ]
      )

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

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

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

-- |
-- Create a value of 'MoveAccountResponse' 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.
newMoveAccountResponse ::
  MoveAccountResponse
newMoveAccountResponse :: MoveAccountResponse
newMoveAccountResponse = MoveAccountResponse
MoveAccountResponse'

instance Prelude.NFData MoveAccountResponse where
  rnf :: MoveAccountResponse -> ()
rnf MoveAccountResponse
_ = ()