{-# 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.NetworkManager.AcceptAttachment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Accepts a core network attachment request.
--
-- Once the attachment request is accepted by a core network owner, the
-- attachment is created and connected to a core network.
module Amazonka.NetworkManager.AcceptAttachment
  ( -- * Creating a Request
    AcceptAttachment (..),
    newAcceptAttachment,

    -- * Request Lenses
    acceptAttachment_attachmentId,

    -- * Destructuring the Response
    AcceptAttachmentResponse (..),
    newAcceptAttachmentResponse,

    -- * Response Lenses
    acceptAttachmentResponse_attachment,
    acceptAttachmentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAcceptAttachment' smart constructor.
data AcceptAttachment = AcceptAttachment'
  { -- | The ID of the attachment.
    AcceptAttachment -> Text
attachmentId :: Prelude.Text
  }
  deriving (AcceptAttachment -> AcceptAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptAttachment -> AcceptAttachment -> Bool
$c/= :: AcceptAttachment -> AcceptAttachment -> Bool
== :: AcceptAttachment -> AcceptAttachment -> Bool
$c== :: AcceptAttachment -> AcceptAttachment -> Bool
Prelude.Eq, ReadPrec [AcceptAttachment]
ReadPrec AcceptAttachment
Int -> ReadS AcceptAttachment
ReadS [AcceptAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptAttachment]
$creadListPrec :: ReadPrec [AcceptAttachment]
readPrec :: ReadPrec AcceptAttachment
$creadPrec :: ReadPrec AcceptAttachment
readList :: ReadS [AcceptAttachment]
$creadList :: ReadS [AcceptAttachment]
readsPrec :: Int -> ReadS AcceptAttachment
$creadsPrec :: Int -> ReadS AcceptAttachment
Prelude.Read, Int -> AcceptAttachment -> ShowS
[AcceptAttachment] -> ShowS
AcceptAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptAttachment] -> ShowS
$cshowList :: [AcceptAttachment] -> ShowS
show :: AcceptAttachment -> String
$cshow :: AcceptAttachment -> String
showsPrec :: Int -> AcceptAttachment -> ShowS
$cshowsPrec :: Int -> AcceptAttachment -> ShowS
Prelude.Show, forall x. Rep AcceptAttachment x -> AcceptAttachment
forall x. AcceptAttachment -> Rep AcceptAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptAttachment x -> AcceptAttachment
$cfrom :: forall x. AcceptAttachment -> Rep AcceptAttachment x
Prelude.Generic)

-- |
-- Create a value of 'AcceptAttachment' 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:
--
-- 'attachmentId', 'acceptAttachment_attachmentId' - The ID of the attachment.
newAcceptAttachment ::
  -- | 'attachmentId'
  Prelude.Text ->
  AcceptAttachment
newAcceptAttachment :: Text -> AcceptAttachment
newAcceptAttachment Text
pAttachmentId_ =
  AcceptAttachment' {$sel:attachmentId:AcceptAttachment' :: Text
attachmentId = Text
pAttachmentId_}

-- | The ID of the attachment.
acceptAttachment_attachmentId :: Lens.Lens' AcceptAttachment Prelude.Text
acceptAttachment_attachmentId :: Lens' AcceptAttachment Text
acceptAttachment_attachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptAttachment' {Text
attachmentId :: Text
$sel:attachmentId:AcceptAttachment' :: AcceptAttachment -> Text
attachmentId} -> Text
attachmentId) (\s :: AcceptAttachment
s@AcceptAttachment' {} Text
a -> AcceptAttachment
s {$sel:attachmentId:AcceptAttachment' :: Text
attachmentId = Text
a} :: AcceptAttachment)

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

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

instance Data.ToHeaders AcceptAttachment where
  toHeaders :: AcceptAttachment -> 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 AcceptAttachment where
  toJSON :: AcceptAttachment -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath AcceptAttachment where
  toPath :: AcceptAttachment -> ByteString
toPath AcceptAttachment' {Text
attachmentId :: Text
$sel:attachmentId:AcceptAttachment' :: AcceptAttachment -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/attachments/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
attachmentId, ByteString
"/accept"]

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

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

-- |
-- Create a value of 'AcceptAttachmentResponse' 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:
--
-- 'attachment', 'acceptAttachmentResponse_attachment' - The response to the attachment request.
--
-- 'httpStatus', 'acceptAttachmentResponse_httpStatus' - The response's http status code.
newAcceptAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptAttachmentResponse
newAcceptAttachmentResponse :: Int -> AcceptAttachmentResponse
newAcceptAttachmentResponse Int
pHttpStatus_ =
  AcceptAttachmentResponse'
    { $sel:attachment:AcceptAttachmentResponse' :: Maybe Attachment
attachment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AcceptAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The response to the attachment request.
acceptAttachmentResponse_attachment :: Lens.Lens' AcceptAttachmentResponse (Prelude.Maybe Attachment)
acceptAttachmentResponse_attachment :: Lens' AcceptAttachmentResponse (Maybe Attachment)
acceptAttachmentResponse_attachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptAttachmentResponse' {Maybe Attachment
attachment :: Maybe Attachment
$sel:attachment:AcceptAttachmentResponse' :: AcceptAttachmentResponse -> Maybe Attachment
attachment} -> Maybe Attachment
attachment) (\s :: AcceptAttachmentResponse
s@AcceptAttachmentResponse' {} Maybe Attachment
a -> AcceptAttachmentResponse
s {$sel:attachment:AcceptAttachmentResponse' :: Maybe Attachment
attachment = Maybe Attachment
a} :: AcceptAttachmentResponse)

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

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