{-# 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.AcceptHandshake
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends a response to the originator of a handshake agreeing to the action
-- proposed by the handshake request.
--
-- You can only call this operation by the following principals when they
-- also have the relevant IAM permissions:
--
-- -   __Invitation to join__ or __Approve all features request__
--     handshakes: only a principal from the member account.
--
--     The user who calls the API for an invitation to join must have the
--     @organizations:AcceptHandshake@ permission. If you enabled all
--     features in the organization, the user must also have the
--     @iam:CreateServiceLinkedRole@ permission so that Organizations can
--     create the required service-linked role named
--     @AWSServiceRoleForOrganizations@. For more information, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_integration_services.html#orgs_integration_service-linked-roles Organizations and Service-Linked Roles>
--     in the /Organizations User Guide/.
--
-- -   __Enable all features final confirmation__ handshake: only a
--     principal from the management account.
--
--     For more information about invitations, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_accounts_invites.html Inviting an Amazon Web Services account to join your organization>
--     in the /Organizations User Guide./ For more information about
--     requests to enable all features in the organization, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_org_support-all-features.html Enabling all features in your organization>
--     in the /Organizations User Guide./
--
-- After you accept a handshake, it continues to appear in the results of
-- relevant APIs for only 30 days. After that, it\'s deleted.
module Amazonka.Organizations.AcceptHandshake
  ( -- * Creating a Request
    AcceptHandshake (..),
    newAcceptHandshake,

    -- * Request Lenses
    acceptHandshake_handshakeId,

    -- * Destructuring the Response
    AcceptHandshakeResponse (..),
    newAcceptHandshakeResponse,

    -- * Response Lenses
    acceptHandshakeResponse_handshake,
    acceptHandshakeResponse_httpStatus,
  )
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:/ 'newAcceptHandshake' smart constructor.
data AcceptHandshake = AcceptHandshake'
  { -- | The unique identifier (ID) of the handshake that you want to accept.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for handshake ID
    -- string requires \"h-\" followed by from 8 to 32 lowercase letters or
    -- digits.
    AcceptHandshake -> Text
handshakeId :: Prelude.Text
  }
  deriving (AcceptHandshake -> AcceptHandshake -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptHandshake -> AcceptHandshake -> Bool
$c/= :: AcceptHandshake -> AcceptHandshake -> Bool
== :: AcceptHandshake -> AcceptHandshake -> Bool
$c== :: AcceptHandshake -> AcceptHandshake -> Bool
Prelude.Eq, ReadPrec [AcceptHandshake]
ReadPrec AcceptHandshake
Int -> ReadS AcceptHandshake
ReadS [AcceptHandshake]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptHandshake]
$creadListPrec :: ReadPrec [AcceptHandshake]
readPrec :: ReadPrec AcceptHandshake
$creadPrec :: ReadPrec AcceptHandshake
readList :: ReadS [AcceptHandshake]
$creadList :: ReadS [AcceptHandshake]
readsPrec :: Int -> ReadS AcceptHandshake
$creadsPrec :: Int -> ReadS AcceptHandshake
Prelude.Read, Int -> AcceptHandshake -> ShowS
[AcceptHandshake] -> ShowS
AcceptHandshake -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptHandshake] -> ShowS
$cshowList :: [AcceptHandshake] -> ShowS
show :: AcceptHandshake -> String
$cshow :: AcceptHandshake -> String
showsPrec :: Int -> AcceptHandshake -> ShowS
$cshowsPrec :: Int -> AcceptHandshake -> ShowS
Prelude.Show, forall x. Rep AcceptHandshake x -> AcceptHandshake
forall x. AcceptHandshake -> Rep AcceptHandshake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptHandshake x -> AcceptHandshake
$cfrom :: forall x. AcceptHandshake -> Rep AcceptHandshake x
Prelude.Generic)

-- |
-- Create a value of 'AcceptHandshake' 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:
--
-- 'handshakeId', 'acceptHandshake_handshakeId' - The unique identifier (ID) of the handshake that you want to accept.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for handshake ID
-- string requires \"h-\" followed by from 8 to 32 lowercase letters or
-- digits.
newAcceptHandshake ::
  -- | 'handshakeId'
  Prelude.Text ->
  AcceptHandshake
newAcceptHandshake :: Text -> AcceptHandshake
newAcceptHandshake Text
pHandshakeId_ =
  AcceptHandshake' {$sel:handshakeId:AcceptHandshake' :: Text
handshakeId = Text
pHandshakeId_}

-- | The unique identifier (ID) of the handshake that you want to accept.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for handshake ID
-- string requires \"h-\" followed by from 8 to 32 lowercase letters or
-- digits.
acceptHandshake_handshakeId :: Lens.Lens' AcceptHandshake Prelude.Text
acceptHandshake_handshakeId :: Lens' AcceptHandshake Text
acceptHandshake_handshakeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptHandshake' {Text
handshakeId :: Text
$sel:handshakeId:AcceptHandshake' :: AcceptHandshake -> Text
handshakeId} -> Text
handshakeId) (\s :: AcceptHandshake
s@AcceptHandshake' {} Text
a -> AcceptHandshake
s {$sel:handshakeId:AcceptHandshake' :: Text
handshakeId = Text
a} :: AcceptHandshake)

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

instance Prelude.NFData AcceptHandshake where
  rnf :: AcceptHandshake -> ()
rnf AcceptHandshake' {Text
handshakeId :: Text
$sel:handshakeId:AcceptHandshake' :: AcceptHandshake -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
handshakeId

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

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

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

-- | /See:/ 'newAcceptHandshakeResponse' smart constructor.
data AcceptHandshakeResponse = AcceptHandshakeResponse'
  { -- | A structure that contains details about the accepted handshake.
    AcceptHandshakeResponse -> Maybe Handshake
handshake :: Prelude.Maybe Handshake,
    -- | The response's http status code.
    AcceptHandshakeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AcceptHandshakeResponse -> AcceptHandshakeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptHandshakeResponse -> AcceptHandshakeResponse -> Bool
$c/= :: AcceptHandshakeResponse -> AcceptHandshakeResponse -> Bool
== :: AcceptHandshakeResponse -> AcceptHandshakeResponse -> Bool
$c== :: AcceptHandshakeResponse -> AcceptHandshakeResponse -> Bool
Prelude.Eq, Int -> AcceptHandshakeResponse -> ShowS
[AcceptHandshakeResponse] -> ShowS
AcceptHandshakeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptHandshakeResponse] -> ShowS
$cshowList :: [AcceptHandshakeResponse] -> ShowS
show :: AcceptHandshakeResponse -> String
$cshow :: AcceptHandshakeResponse -> String
showsPrec :: Int -> AcceptHandshakeResponse -> ShowS
$cshowsPrec :: Int -> AcceptHandshakeResponse -> ShowS
Prelude.Show, forall x. Rep AcceptHandshakeResponse x -> AcceptHandshakeResponse
forall x. AcceptHandshakeResponse -> Rep AcceptHandshakeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptHandshakeResponse x -> AcceptHandshakeResponse
$cfrom :: forall x. AcceptHandshakeResponse -> Rep AcceptHandshakeResponse x
Prelude.Generic)

-- |
-- Create a value of 'AcceptHandshakeResponse' 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:
--
-- 'handshake', 'acceptHandshakeResponse_handshake' - A structure that contains details about the accepted handshake.
--
-- 'httpStatus', 'acceptHandshakeResponse_httpStatus' - The response's http status code.
newAcceptHandshakeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptHandshakeResponse
newAcceptHandshakeResponse :: Int -> AcceptHandshakeResponse
newAcceptHandshakeResponse Int
pHttpStatus_ =
  AcceptHandshakeResponse'
    { $sel:handshake:AcceptHandshakeResponse' :: Maybe Handshake
handshake =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AcceptHandshakeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains details about the accepted handshake.
acceptHandshakeResponse_handshake :: Lens.Lens' AcceptHandshakeResponse (Prelude.Maybe Handshake)
acceptHandshakeResponse_handshake :: Lens' AcceptHandshakeResponse (Maybe Handshake)
acceptHandshakeResponse_handshake = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptHandshakeResponse' {Maybe Handshake
handshake :: Maybe Handshake
$sel:handshake:AcceptHandshakeResponse' :: AcceptHandshakeResponse -> Maybe Handshake
handshake} -> Maybe Handshake
handshake) (\s :: AcceptHandshakeResponse
s@AcceptHandshakeResponse' {} Maybe Handshake
a -> AcceptHandshakeResponse
s {$sel:handshake:AcceptHandshakeResponse' :: Maybe Handshake
handshake = Maybe Handshake
a} :: AcceptHandshakeResponse)

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

instance Prelude.NFData AcceptHandshakeResponse where
  rnf :: AcceptHandshakeResponse -> ()
rnf AcceptHandshakeResponse' {Int
Maybe Handshake
httpStatus :: Int
handshake :: Maybe Handshake
$sel:httpStatus:AcceptHandshakeResponse' :: AcceptHandshakeResponse -> Int
$sel:handshake:AcceptHandshakeResponse' :: AcceptHandshakeResponse -> Maybe Handshake
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Handshake
handshake
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus