{-# 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.PrivateNetworks.Ping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Checks the health of the service.
module Amazonka.PrivateNetworks.Ping
  ( -- * Creating a Request
    Ping (..),
    newPing,

    -- * Destructuring the Response
    PingResponse (..),
    newPingResponse,

    -- * Response Lenses
    pingResponse_status,
    pingResponse_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 Amazonka.PrivateNetworks.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

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

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

instance Core.AWSRequest Ping where
  type AWSResponse Ping = PingResponse
  request :: (Service -> Service) -> Ping -> Request Ping
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy Ping
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Ping)))
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 -> PingResponse
PingResponse'
            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
"status")
            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 Ping where
  hashWithSalt :: Int -> Ping -> Int
hashWithSalt Int
_salt Ping
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance Data.ToHeaders Ping where
  toHeaders :: Ping -> 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.ToPath Ping where
  toPath :: Ping -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/ping"

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

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

-- |
-- Create a value of 'PingResponse' 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:
--
-- 'status', 'pingResponse_status' - Information about the health of the service.
--
-- 'httpStatus', 'pingResponse_httpStatus' - The response's http status code.
newPingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PingResponse
newPingResponse :: Int -> PingResponse
newPingResponse Int
pHttpStatus_ =
  PingResponse'
    { $sel:status:PingResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the health of the service.
pingResponse_status :: Lens.Lens' PingResponse (Prelude.Maybe Prelude.Text)
pingResponse_status :: Lens' PingResponse (Maybe Text)
pingResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PingResponse' {Maybe Text
status :: Maybe Text
$sel:status:PingResponse' :: PingResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: PingResponse
s@PingResponse' {} Maybe Text
a -> PingResponse
s {$sel:status:PingResponse' :: Maybe Text
status = Maybe Text
a} :: PingResponse)

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

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