{-# 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.CancelHandshake
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels a handshake. Canceling a handshake sets the handshake state to
-- @CANCELED@.
--
-- This operation can be called only from the account that originated the
-- handshake. The recipient of the handshake can\'t cancel it, but can use
-- DeclineHandshake instead. After a handshake is canceled, the recipient
-- can no longer respond to that handshake.
--
-- After you cancel a handshake, it continues to appear in the results of
-- relevant APIs for only 30 days. After that, it\'s deleted.
module Amazonka.Organizations.CancelHandshake
  ( -- * Creating a Request
    CancelHandshake (..),
    newCancelHandshake,

    -- * Request Lenses
    cancelHandshake_handshakeId,

    -- * Destructuring the Response
    CancelHandshakeResponse (..),
    newCancelHandshakeResponse,

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

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

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

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

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

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

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

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

-- |
-- Create a value of 'CancelHandshakeResponse' 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', 'cancelHandshakeResponse_handshake' - A structure that contains details about the handshake that you canceled.
--
-- 'httpStatus', 'cancelHandshakeResponse_httpStatus' - The response's http status code.
newCancelHandshakeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelHandshakeResponse
newCancelHandshakeResponse :: Int -> CancelHandshakeResponse
newCancelHandshakeResponse Int
pHttpStatus_ =
  CancelHandshakeResponse'
    { $sel:handshake:CancelHandshakeResponse' :: Maybe Handshake
handshake =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelHandshakeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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