{-# 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.MGN.AssociateSourceServers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associate source servers to application.
module Amazonka.MGN.AssociateSourceServers
  ( -- * Creating a Request
    AssociateSourceServers (..),
    newAssociateSourceServers,

    -- * Request Lenses
    associateSourceServers_applicationID,
    associateSourceServers_sourceServerIDs,

    -- * Destructuring the Response
    AssociateSourceServersResponse (..),
    newAssociateSourceServersResponse,

    -- * Response Lenses
    associateSourceServersResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAssociateSourceServers' smart constructor.
data AssociateSourceServers = AssociateSourceServers'
  { -- | Application ID.
    AssociateSourceServers -> Text
applicationID :: Prelude.Text,
    -- | Source server IDs list.
    AssociateSourceServers -> NonEmpty Text
sourceServerIDs :: Prelude.NonEmpty Prelude.Text
  }
  deriving (AssociateSourceServers -> AssociateSourceServers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateSourceServers -> AssociateSourceServers -> Bool
$c/= :: AssociateSourceServers -> AssociateSourceServers -> Bool
== :: AssociateSourceServers -> AssociateSourceServers -> Bool
$c== :: AssociateSourceServers -> AssociateSourceServers -> Bool
Prelude.Eq, ReadPrec [AssociateSourceServers]
ReadPrec AssociateSourceServers
Int -> ReadS AssociateSourceServers
ReadS [AssociateSourceServers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateSourceServers]
$creadListPrec :: ReadPrec [AssociateSourceServers]
readPrec :: ReadPrec AssociateSourceServers
$creadPrec :: ReadPrec AssociateSourceServers
readList :: ReadS [AssociateSourceServers]
$creadList :: ReadS [AssociateSourceServers]
readsPrec :: Int -> ReadS AssociateSourceServers
$creadsPrec :: Int -> ReadS AssociateSourceServers
Prelude.Read, Int -> AssociateSourceServers -> ShowS
[AssociateSourceServers] -> ShowS
AssociateSourceServers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateSourceServers] -> ShowS
$cshowList :: [AssociateSourceServers] -> ShowS
show :: AssociateSourceServers -> String
$cshow :: AssociateSourceServers -> String
showsPrec :: Int -> AssociateSourceServers -> ShowS
$cshowsPrec :: Int -> AssociateSourceServers -> ShowS
Prelude.Show, forall x. Rep AssociateSourceServers x -> AssociateSourceServers
forall x. AssociateSourceServers -> Rep AssociateSourceServers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateSourceServers x -> AssociateSourceServers
$cfrom :: forall x. AssociateSourceServers -> Rep AssociateSourceServers x
Prelude.Generic)

-- |
-- Create a value of 'AssociateSourceServers' 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:
--
-- 'applicationID', 'associateSourceServers_applicationID' - Application ID.
--
-- 'sourceServerIDs', 'associateSourceServers_sourceServerIDs' - Source server IDs list.
newAssociateSourceServers ::
  -- | 'applicationID'
  Prelude.Text ->
  -- | 'sourceServerIDs'
  Prelude.NonEmpty Prelude.Text ->
  AssociateSourceServers
newAssociateSourceServers :: Text -> NonEmpty Text -> AssociateSourceServers
newAssociateSourceServers
  Text
pApplicationID_
  NonEmpty Text
pSourceServerIDs_ =
    AssociateSourceServers'
      { $sel:applicationID:AssociateSourceServers' :: Text
applicationID =
          Text
pApplicationID_,
        $sel:sourceServerIDs:AssociateSourceServers' :: NonEmpty Text
sourceServerIDs =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSourceServerIDs_
      }

-- | Application ID.
associateSourceServers_applicationID :: Lens.Lens' AssociateSourceServers Prelude.Text
associateSourceServers_applicationID :: Lens' AssociateSourceServers Text
associateSourceServers_applicationID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSourceServers' {Text
applicationID :: Text
$sel:applicationID:AssociateSourceServers' :: AssociateSourceServers -> Text
applicationID} -> Text
applicationID) (\s :: AssociateSourceServers
s@AssociateSourceServers' {} Text
a -> AssociateSourceServers
s {$sel:applicationID:AssociateSourceServers' :: Text
applicationID = Text
a} :: AssociateSourceServers)

-- | Source server IDs list.
associateSourceServers_sourceServerIDs :: Lens.Lens' AssociateSourceServers (Prelude.NonEmpty Prelude.Text)
associateSourceServers_sourceServerIDs :: Lens' AssociateSourceServers (NonEmpty Text)
associateSourceServers_sourceServerIDs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSourceServers' {NonEmpty Text
sourceServerIDs :: NonEmpty Text
$sel:sourceServerIDs:AssociateSourceServers' :: AssociateSourceServers -> NonEmpty Text
sourceServerIDs} -> NonEmpty Text
sourceServerIDs) (\s :: AssociateSourceServers
s@AssociateSourceServers' {} NonEmpty Text
a -> AssociateSourceServers
s {$sel:sourceServerIDs:AssociateSourceServers' :: NonEmpty Text
sourceServerIDs = NonEmpty Text
a} :: AssociateSourceServers) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest AssociateSourceServers where
  type
    AWSResponse AssociateSourceServers =
      AssociateSourceServersResponse
  request :: (Service -> Service)
-> AssociateSourceServers -> Request AssociateSourceServers
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 AssociateSourceServers
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateSourceServers)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateSourceServersResponse
AssociateSourceServersResponse'
            forall (f :: * -> *) a b. Functor 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 AssociateSourceServers where
  hashWithSalt :: Int -> AssociateSourceServers -> Int
hashWithSalt Int
_salt AssociateSourceServers' {NonEmpty Text
Text
sourceServerIDs :: NonEmpty Text
applicationID :: Text
$sel:sourceServerIDs:AssociateSourceServers' :: AssociateSourceServers -> NonEmpty Text
$sel:applicationID:AssociateSourceServers' :: AssociateSourceServers -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
sourceServerIDs

instance Prelude.NFData AssociateSourceServers where
  rnf :: AssociateSourceServers -> ()
rnf AssociateSourceServers' {NonEmpty Text
Text
sourceServerIDs :: NonEmpty Text
applicationID :: Text
$sel:sourceServerIDs:AssociateSourceServers' :: AssociateSourceServers -> NonEmpty Text
$sel:applicationID:AssociateSourceServers' :: AssociateSourceServers -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationID
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
sourceServerIDs

instance Data.ToHeaders AssociateSourceServers where
  toHeaders :: AssociateSourceServers -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AssociateSourceServers where
  toJSON :: AssociateSourceServers -> Value
toJSON AssociateSourceServers' {NonEmpty Text
Text
sourceServerIDs :: NonEmpty Text
applicationID :: Text
$sel:sourceServerIDs:AssociateSourceServers' :: AssociateSourceServers -> NonEmpty Text
$sel:applicationID:AssociateSourceServers' :: AssociateSourceServers -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationID),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sourceServerIDs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
sourceServerIDs)
          ]
      )

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

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

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

-- |
-- Create a value of 'AssociateSourceServersResponse' 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:
--
-- 'httpStatus', 'associateSourceServersResponse_httpStatus' - The response's http status code.
newAssociateSourceServersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateSourceServersResponse
newAssociateSourceServersResponse :: Int -> AssociateSourceServersResponse
newAssociateSourceServersResponse Int
pHttpStatus_ =
  AssociateSourceServersResponse'
    { $sel:httpStatus:AssociateSourceServersResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    AssociateSourceServersResponse
  where
  rnf :: AssociateSourceServersResponse -> ()
rnf AssociateSourceServersResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateSourceServersResponse' :: AssociateSourceServersResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus