{-# 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.AssociateConnectionAlias
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates the specified connection alias with the specified directory
-- to enable cross-Region redirection. For more information, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/cross-region-redirection.html Cross-Region Redirection for Amazon WorkSpaces>.
--
-- Before performing this operation, call
-- <https://docs.aws.amazon.com/workspaces/latest/api/API_DescribeConnectionAliases.html DescribeConnectionAliases>
-- to make sure that the current state of the connection alias is
-- @CREATED@.
module Amazonka.WorkSpaces.AssociateConnectionAlias
  ( -- * Creating a Request
    AssociateConnectionAlias (..),
    newAssociateConnectionAlias,

    -- * Request Lenses
    associateConnectionAlias_aliasId,
    associateConnectionAlias_resourceId,

    -- * Destructuring the Response
    AssociateConnectionAliasResponse (..),
    newAssociateConnectionAliasResponse,

    -- * Response Lenses
    associateConnectionAliasResponse_connectionIdentifier,
    associateConnectionAliasResponse_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:/ 'newAssociateConnectionAlias' smart constructor.
data AssociateConnectionAlias = AssociateConnectionAlias'
  { -- | The identifier of the connection alias.
    AssociateConnectionAlias -> Text
aliasId :: Prelude.Text,
    -- | The identifier of the directory to associate the connection alias with.
    AssociateConnectionAlias -> Text
resourceId :: Prelude.Text
  }
  deriving (AssociateConnectionAlias -> AssociateConnectionAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateConnectionAlias -> AssociateConnectionAlias -> Bool
$c/= :: AssociateConnectionAlias -> AssociateConnectionAlias -> Bool
== :: AssociateConnectionAlias -> AssociateConnectionAlias -> Bool
$c== :: AssociateConnectionAlias -> AssociateConnectionAlias -> Bool
Prelude.Eq, ReadPrec [AssociateConnectionAlias]
ReadPrec AssociateConnectionAlias
Int -> ReadS AssociateConnectionAlias
ReadS [AssociateConnectionAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateConnectionAlias]
$creadListPrec :: ReadPrec [AssociateConnectionAlias]
readPrec :: ReadPrec AssociateConnectionAlias
$creadPrec :: ReadPrec AssociateConnectionAlias
readList :: ReadS [AssociateConnectionAlias]
$creadList :: ReadS [AssociateConnectionAlias]
readsPrec :: Int -> ReadS AssociateConnectionAlias
$creadsPrec :: Int -> ReadS AssociateConnectionAlias
Prelude.Read, Int -> AssociateConnectionAlias -> ShowS
[AssociateConnectionAlias] -> ShowS
AssociateConnectionAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateConnectionAlias] -> ShowS
$cshowList :: [AssociateConnectionAlias] -> ShowS
show :: AssociateConnectionAlias -> String
$cshow :: AssociateConnectionAlias -> String
showsPrec :: Int -> AssociateConnectionAlias -> ShowS
$cshowsPrec :: Int -> AssociateConnectionAlias -> ShowS
Prelude.Show, forall x.
Rep AssociateConnectionAlias x -> AssociateConnectionAlias
forall x.
AssociateConnectionAlias -> Rep AssociateConnectionAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateConnectionAlias x -> AssociateConnectionAlias
$cfrom :: forall x.
AssociateConnectionAlias -> Rep AssociateConnectionAlias x
Prelude.Generic)

-- |
-- Create a value of 'AssociateConnectionAlias' 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:
--
-- 'aliasId', 'associateConnectionAlias_aliasId' - The identifier of the connection alias.
--
-- 'resourceId', 'associateConnectionAlias_resourceId' - The identifier of the directory to associate the connection alias with.
newAssociateConnectionAlias ::
  -- | 'aliasId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  AssociateConnectionAlias
newAssociateConnectionAlias :: Text -> Text -> AssociateConnectionAlias
newAssociateConnectionAlias Text
pAliasId_ Text
pResourceId_ =
  AssociateConnectionAlias'
    { $sel:aliasId:AssociateConnectionAlias' :: Text
aliasId = Text
pAliasId_,
      $sel:resourceId:AssociateConnectionAlias' :: Text
resourceId = Text
pResourceId_
    }

-- | The identifier of the connection alias.
associateConnectionAlias_aliasId :: Lens.Lens' AssociateConnectionAlias Prelude.Text
associateConnectionAlias_aliasId :: Lens' AssociateConnectionAlias Text
associateConnectionAlias_aliasId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectionAlias' {Text
aliasId :: Text
$sel:aliasId:AssociateConnectionAlias' :: AssociateConnectionAlias -> Text
aliasId} -> Text
aliasId) (\s :: AssociateConnectionAlias
s@AssociateConnectionAlias' {} Text
a -> AssociateConnectionAlias
s {$sel:aliasId:AssociateConnectionAlias' :: Text
aliasId = Text
a} :: AssociateConnectionAlias)

-- | The identifier of the directory to associate the connection alias with.
associateConnectionAlias_resourceId :: Lens.Lens' AssociateConnectionAlias Prelude.Text
associateConnectionAlias_resourceId :: Lens' AssociateConnectionAlias Text
associateConnectionAlias_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectionAlias' {Text
resourceId :: Text
$sel:resourceId:AssociateConnectionAlias' :: AssociateConnectionAlias -> Text
resourceId} -> Text
resourceId) (\s :: AssociateConnectionAlias
s@AssociateConnectionAlias' {} Text
a -> AssociateConnectionAlias
s {$sel:resourceId:AssociateConnectionAlias' :: Text
resourceId = Text
a} :: AssociateConnectionAlias)

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

instance Prelude.NFData AssociateConnectionAlias where
  rnf :: AssociateConnectionAlias -> ()
rnf AssociateConnectionAlias' {Text
resourceId :: Text
aliasId :: Text
$sel:resourceId:AssociateConnectionAlias' :: AssociateConnectionAlias -> Text
$sel:aliasId:AssociateConnectionAlias' :: AssociateConnectionAlias -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
aliasId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

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

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

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

-- | /See:/ 'newAssociateConnectionAliasResponse' smart constructor.
data AssociateConnectionAliasResponse = AssociateConnectionAliasResponse'
  { -- | The identifier of the connection alias association. You use the
    -- connection identifier in the DNS TXT record when you\'re configuring
    -- your DNS routing policies.
    AssociateConnectionAliasResponse -> Maybe Text
connectionIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AssociateConnectionAliasResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateConnectionAliasResponse
-> AssociateConnectionAliasResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateConnectionAliasResponse
-> AssociateConnectionAliasResponse -> Bool
$c/= :: AssociateConnectionAliasResponse
-> AssociateConnectionAliasResponse -> Bool
== :: AssociateConnectionAliasResponse
-> AssociateConnectionAliasResponse -> Bool
$c== :: AssociateConnectionAliasResponse
-> AssociateConnectionAliasResponse -> Bool
Prelude.Eq, ReadPrec [AssociateConnectionAliasResponse]
ReadPrec AssociateConnectionAliasResponse
Int -> ReadS AssociateConnectionAliasResponse
ReadS [AssociateConnectionAliasResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateConnectionAliasResponse]
$creadListPrec :: ReadPrec [AssociateConnectionAliasResponse]
readPrec :: ReadPrec AssociateConnectionAliasResponse
$creadPrec :: ReadPrec AssociateConnectionAliasResponse
readList :: ReadS [AssociateConnectionAliasResponse]
$creadList :: ReadS [AssociateConnectionAliasResponse]
readsPrec :: Int -> ReadS AssociateConnectionAliasResponse
$creadsPrec :: Int -> ReadS AssociateConnectionAliasResponse
Prelude.Read, Int -> AssociateConnectionAliasResponse -> ShowS
[AssociateConnectionAliasResponse] -> ShowS
AssociateConnectionAliasResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateConnectionAliasResponse] -> ShowS
$cshowList :: [AssociateConnectionAliasResponse] -> ShowS
show :: AssociateConnectionAliasResponse -> String
$cshow :: AssociateConnectionAliasResponse -> String
showsPrec :: Int -> AssociateConnectionAliasResponse -> ShowS
$cshowsPrec :: Int -> AssociateConnectionAliasResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateConnectionAliasResponse x
-> AssociateConnectionAliasResponse
forall x.
AssociateConnectionAliasResponse
-> Rep AssociateConnectionAliasResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateConnectionAliasResponse x
-> AssociateConnectionAliasResponse
$cfrom :: forall x.
AssociateConnectionAliasResponse
-> Rep AssociateConnectionAliasResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateConnectionAliasResponse' 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:
--
-- 'connectionIdentifier', 'associateConnectionAliasResponse_connectionIdentifier' - The identifier of the connection alias association. You use the
-- connection identifier in the DNS TXT record when you\'re configuring
-- your DNS routing policies.
--
-- 'httpStatus', 'associateConnectionAliasResponse_httpStatus' - The response's http status code.
newAssociateConnectionAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateConnectionAliasResponse
newAssociateConnectionAliasResponse :: Int -> AssociateConnectionAliasResponse
newAssociateConnectionAliasResponse Int
pHttpStatus_ =
  AssociateConnectionAliasResponse'
    { $sel:connectionIdentifier:AssociateConnectionAliasResponse' :: Maybe Text
connectionIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateConnectionAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the connection alias association. You use the
-- connection identifier in the DNS TXT record when you\'re configuring
-- your DNS routing policies.
associateConnectionAliasResponse_connectionIdentifier :: Lens.Lens' AssociateConnectionAliasResponse (Prelude.Maybe Prelude.Text)
associateConnectionAliasResponse_connectionIdentifier :: Lens' AssociateConnectionAliasResponse (Maybe Text)
associateConnectionAliasResponse_connectionIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectionAliasResponse' {Maybe Text
connectionIdentifier :: Maybe Text
$sel:connectionIdentifier:AssociateConnectionAliasResponse' :: AssociateConnectionAliasResponse -> Maybe Text
connectionIdentifier} -> Maybe Text
connectionIdentifier) (\s :: AssociateConnectionAliasResponse
s@AssociateConnectionAliasResponse' {} Maybe Text
a -> AssociateConnectionAliasResponse
s {$sel:connectionIdentifier:AssociateConnectionAliasResponse' :: Maybe Text
connectionIdentifier = Maybe Text
a} :: AssociateConnectionAliasResponse)

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

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