{-# 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.DescribeHandshake
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a previously requested handshake. The
-- handshake ID comes from the response to the original
-- InviteAccountToOrganization operation that generated the handshake.
--
-- You can access handshakes that are @ACCEPTED@, @DECLINED@, or @CANCELED@
-- for only 30 days after they change to that state. They\'re then deleted
-- and no longer accessible.
--
-- This operation can be called from any account in the organization.
module Amazonka.Organizations.DescribeHandshake
  ( -- * Creating a Request
    DescribeHandshake (..),
    newDescribeHandshake,

    -- * Request Lenses
    describeHandshake_handshakeId,

    -- * Destructuring the Response
    DescribeHandshakeResponse (..),
    newDescribeHandshakeResponse,

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

-- |
-- Create a value of 'DescribeHandshake' 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', 'describeHandshake_handshakeId' - The unique identifier (ID) of the handshake that you want information
-- about. You can get the ID from the original call to
-- InviteAccountToOrganization, or from a call to ListHandshakesForAccount
-- or ListHandshakesForOrganization.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for handshake ID
-- string requires \"h-\" followed by from 8 to 32 lowercase letters or
-- digits.
newDescribeHandshake ::
  -- | 'handshakeId'
  Prelude.Text ->
  DescribeHandshake
newDescribeHandshake :: Text -> DescribeHandshake
newDescribeHandshake Text
pHandshakeId_ =
  DescribeHandshake' {$sel:handshakeId:DescribeHandshake' :: Text
handshakeId = Text
pHandshakeId_}

-- | The unique identifier (ID) of the handshake that you want information
-- about. You can get the ID from the original call to
-- InviteAccountToOrganization, or from a call to ListHandshakesForAccount
-- or ListHandshakesForOrganization.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for handshake ID
-- string requires \"h-\" followed by from 8 to 32 lowercase letters or
-- digits.
describeHandshake_handshakeId :: Lens.Lens' DescribeHandshake Prelude.Text
describeHandshake_handshakeId :: Lens' DescribeHandshake Text
describeHandshake_handshakeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeHandshake' {Text
handshakeId :: Text
$sel:handshakeId:DescribeHandshake' :: DescribeHandshake -> Text
handshakeId} -> Text
handshakeId) (\s :: DescribeHandshake
s@DescribeHandshake' {} Text
a -> DescribeHandshake
s {$sel:handshakeId:DescribeHandshake' :: Text
handshakeId = Text
a} :: DescribeHandshake)

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

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

instance Data.ToHeaders DescribeHandshake where
  toHeaders :: DescribeHandshake -> 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.DescribeHandshake" ::
                          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 DescribeHandshake where
  toJSON :: DescribeHandshake -> Value
toJSON DescribeHandshake' {Text
handshakeId :: Text
$sel:handshakeId:DescribeHandshake' :: DescribeHandshake -> 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 DescribeHandshake where
  toPath :: DescribeHandshake -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DescribeHandshakeResponse' 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', 'describeHandshakeResponse_handshake' - A structure that contains information about the specified handshake.
--
-- 'httpStatus', 'describeHandshakeResponse_httpStatus' - The response's http status code.
newDescribeHandshakeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeHandshakeResponse
newDescribeHandshakeResponse :: Int -> DescribeHandshakeResponse
newDescribeHandshakeResponse Int
pHttpStatus_ =
  DescribeHandshakeResponse'
    { $sel:handshake:DescribeHandshakeResponse' :: Maybe Handshake
handshake =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeHandshakeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData DescribeHandshakeResponse where
  rnf :: DescribeHandshakeResponse -> ()
rnf DescribeHandshakeResponse' {Int
Maybe Handshake
httpStatus :: Int
handshake :: Maybe Handshake
$sel:httpStatus:DescribeHandshakeResponse' :: DescribeHandshakeResponse -> Int
$sel:handshake:DescribeHandshakeResponse' :: DescribeHandshakeResponse -> 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