{-# 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.Lightsail.PeerVpc
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Peers the Lightsail VPC with the user\'s default VPC.
module Amazonka.Lightsail.PeerVpc
  ( -- * Creating a Request
    PeerVpc (..),
    newPeerVpc,

    -- * Destructuring the Response
    PeerVpcResponse (..),
    newPeerVpcResponse,

    -- * Response Lenses
    peerVpcResponse_operation,
    peerVpcResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'PeerVpc' 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.
newPeerVpc ::
  PeerVpc
newPeerVpc :: PeerVpc
newPeerVpc = PeerVpc
PeerVpc'

instance Core.AWSRequest PeerVpc where
  type AWSResponse PeerVpc = PeerVpcResponse
  request :: (Service -> Service) -> PeerVpc -> Request PeerVpc
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 PeerVpc
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PeerVpc)))
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 Operation -> Int -> PeerVpcResponse
PeerVpcResponse'
            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
"operation")
            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 PeerVpc where
  hashWithSalt :: Int -> PeerVpc -> Int
hashWithSalt Int
_salt PeerVpc
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData PeerVpc where
  rnf :: PeerVpc -> ()
rnf PeerVpc
_ = ()

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

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

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

-- | /See:/ 'newPeerVpcResponse' smart constructor.
data PeerVpcResponse = PeerVpcResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    PeerVpcResponse -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | The response's http status code.
    PeerVpcResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PeerVpcResponse -> PeerVpcResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeerVpcResponse -> PeerVpcResponse -> Bool
$c/= :: PeerVpcResponse -> PeerVpcResponse -> Bool
== :: PeerVpcResponse -> PeerVpcResponse -> Bool
$c== :: PeerVpcResponse -> PeerVpcResponse -> Bool
Prelude.Eq, ReadPrec [PeerVpcResponse]
ReadPrec PeerVpcResponse
Int -> ReadS PeerVpcResponse
ReadS [PeerVpcResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PeerVpcResponse]
$creadListPrec :: ReadPrec [PeerVpcResponse]
readPrec :: ReadPrec PeerVpcResponse
$creadPrec :: ReadPrec PeerVpcResponse
readList :: ReadS [PeerVpcResponse]
$creadList :: ReadS [PeerVpcResponse]
readsPrec :: Int -> ReadS PeerVpcResponse
$creadsPrec :: Int -> ReadS PeerVpcResponse
Prelude.Read, Int -> PeerVpcResponse -> ShowS
[PeerVpcResponse] -> ShowS
PeerVpcResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PeerVpcResponse] -> ShowS
$cshowList :: [PeerVpcResponse] -> ShowS
show :: PeerVpcResponse -> String
$cshow :: PeerVpcResponse -> String
showsPrec :: Int -> PeerVpcResponse -> ShowS
$cshowsPrec :: Int -> PeerVpcResponse -> ShowS
Prelude.Show, forall x. Rep PeerVpcResponse x -> PeerVpcResponse
forall x. PeerVpcResponse -> Rep PeerVpcResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PeerVpcResponse x -> PeerVpcResponse
$cfrom :: forall x. PeerVpcResponse -> Rep PeerVpcResponse x
Prelude.Generic)

-- |
-- Create a value of 'PeerVpcResponse' 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:
--
-- 'operation', 'peerVpcResponse_operation' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'peerVpcResponse_httpStatus' - The response's http status code.
newPeerVpcResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PeerVpcResponse
newPeerVpcResponse :: Int -> PeerVpcResponse
newPeerVpcResponse Int
pHttpStatus_ =
  PeerVpcResponse'
    { $sel:operation:PeerVpcResponse' :: Maybe Operation
operation = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PeerVpcResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
peerVpcResponse_operation :: Lens.Lens' PeerVpcResponse (Prelude.Maybe Operation)
peerVpcResponse_operation :: Lens' PeerVpcResponse (Maybe Operation)
peerVpcResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PeerVpcResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:PeerVpcResponse' :: PeerVpcResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: PeerVpcResponse
s@PeerVpcResponse' {} Maybe Operation
a -> PeerVpcResponse
s {$sel:operation:PeerVpcResponse' :: Maybe Operation
operation = Maybe Operation
a} :: PeerVpcResponse)

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

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