{-# 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.Proton.GetServiceInstance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get detailed data for a service instance. A service instance is an
-- instantiation of service template and it runs in a specific environment.
module Amazonka.Proton.GetServiceInstance
  ( -- * Creating a Request
    GetServiceInstance (..),
    newGetServiceInstance,

    -- * Request Lenses
    getServiceInstance_name,
    getServiceInstance_serviceName,

    -- * Destructuring the Response
    GetServiceInstanceResponse (..),
    newGetServiceInstanceResponse,

    -- * Response Lenses
    getServiceInstanceResponse_httpStatus,
    getServiceInstanceResponse_serviceInstance,
  )
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.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetServiceInstance' smart constructor.
data GetServiceInstance = GetServiceInstance'
  { -- | The name of a service instance that you want to get the detailed data
    -- for.
    GetServiceInstance -> Text
name :: Prelude.Text,
    -- | The name of the service that the service instance belongs to.
    GetServiceInstance -> Text
serviceName :: Prelude.Text
  }
  deriving (GetServiceInstance -> GetServiceInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceInstance -> GetServiceInstance -> Bool
$c/= :: GetServiceInstance -> GetServiceInstance -> Bool
== :: GetServiceInstance -> GetServiceInstance -> Bool
$c== :: GetServiceInstance -> GetServiceInstance -> Bool
Prelude.Eq, ReadPrec [GetServiceInstance]
ReadPrec GetServiceInstance
Int -> ReadS GetServiceInstance
ReadS [GetServiceInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceInstance]
$creadListPrec :: ReadPrec [GetServiceInstance]
readPrec :: ReadPrec GetServiceInstance
$creadPrec :: ReadPrec GetServiceInstance
readList :: ReadS [GetServiceInstance]
$creadList :: ReadS [GetServiceInstance]
readsPrec :: Int -> ReadS GetServiceInstance
$creadsPrec :: Int -> ReadS GetServiceInstance
Prelude.Read, Int -> GetServiceInstance -> ShowS
[GetServiceInstance] -> ShowS
GetServiceInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceInstance] -> ShowS
$cshowList :: [GetServiceInstance] -> ShowS
show :: GetServiceInstance -> String
$cshow :: GetServiceInstance -> String
showsPrec :: Int -> GetServiceInstance -> ShowS
$cshowsPrec :: Int -> GetServiceInstance -> ShowS
Prelude.Show, forall x. Rep GetServiceInstance x -> GetServiceInstance
forall x. GetServiceInstance -> Rep GetServiceInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetServiceInstance x -> GetServiceInstance
$cfrom :: forall x. GetServiceInstance -> Rep GetServiceInstance x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceInstance' 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:
--
-- 'name', 'getServiceInstance_name' - The name of a service instance that you want to get the detailed data
-- for.
--
-- 'serviceName', 'getServiceInstance_serviceName' - The name of the service that the service instance belongs to.
newGetServiceInstance ::
  -- | 'name'
  Prelude.Text ->
  -- | 'serviceName'
  Prelude.Text ->
  GetServiceInstance
newGetServiceInstance :: Text -> Text -> GetServiceInstance
newGetServiceInstance Text
pName_ Text
pServiceName_ =
  GetServiceInstance'
    { $sel:name:GetServiceInstance' :: Text
name = Text
pName_,
      $sel:serviceName:GetServiceInstance' :: Text
serviceName = Text
pServiceName_
    }

-- | The name of a service instance that you want to get the detailed data
-- for.
getServiceInstance_name :: Lens.Lens' GetServiceInstance Prelude.Text
getServiceInstance_name :: Lens' GetServiceInstance Text
getServiceInstance_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceInstance' {Text
name :: Text
$sel:name:GetServiceInstance' :: GetServiceInstance -> Text
name} -> Text
name) (\s :: GetServiceInstance
s@GetServiceInstance' {} Text
a -> GetServiceInstance
s {$sel:name:GetServiceInstance' :: Text
name = Text
a} :: GetServiceInstance)

-- | The name of the service that the service instance belongs to.
getServiceInstance_serviceName :: Lens.Lens' GetServiceInstance Prelude.Text
getServiceInstance_serviceName :: Lens' GetServiceInstance Text
getServiceInstance_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceInstance' {Text
serviceName :: Text
$sel:serviceName:GetServiceInstance' :: GetServiceInstance -> Text
serviceName} -> Text
serviceName) (\s :: GetServiceInstance
s@GetServiceInstance' {} Text
a -> GetServiceInstance
s {$sel:serviceName:GetServiceInstance' :: Text
serviceName = Text
a} :: GetServiceInstance)

instance Core.AWSRequest GetServiceInstance where
  type
    AWSResponse GetServiceInstance =
      GetServiceInstanceResponse
  request :: (Service -> Service)
-> GetServiceInstance -> Request GetServiceInstance
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 GetServiceInstance
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetServiceInstance)))
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 ->
          Int -> ServiceInstance -> GetServiceInstanceResponse
GetServiceInstanceResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"serviceInstance")
      )

instance Prelude.Hashable GetServiceInstance where
  hashWithSalt :: Int -> GetServiceInstance -> Int
hashWithSalt Int
_salt GetServiceInstance' {Text
serviceName :: Text
name :: Text
$sel:serviceName:GetServiceInstance' :: GetServiceInstance -> Text
$sel:name:GetServiceInstance' :: GetServiceInstance -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName

instance Prelude.NFData GetServiceInstance where
  rnf :: GetServiceInstance -> ()
rnf GetServiceInstance' {Text
serviceName :: Text
name :: Text
$sel:serviceName:GetServiceInstance' :: GetServiceInstance -> Text
$sel:name:GetServiceInstance' :: GetServiceInstance -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceName

instance Data.ToHeaders GetServiceInstance where
  toHeaders :: GetServiceInstance -> 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
"AwsProton20200720.GetServiceInstance" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newGetServiceInstanceResponse' smart constructor.
data GetServiceInstanceResponse = GetServiceInstanceResponse'
  { -- | The response's http status code.
    GetServiceInstanceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The detailed data of the requested service instance.
    GetServiceInstanceResponse -> ServiceInstance
serviceInstance :: ServiceInstance
  }
  deriving (GetServiceInstanceResponse -> GetServiceInstanceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceInstanceResponse -> GetServiceInstanceResponse -> Bool
$c/= :: GetServiceInstanceResponse -> GetServiceInstanceResponse -> Bool
== :: GetServiceInstanceResponse -> GetServiceInstanceResponse -> Bool
$c== :: GetServiceInstanceResponse -> GetServiceInstanceResponse -> Bool
Prelude.Eq, Int -> GetServiceInstanceResponse -> ShowS
[GetServiceInstanceResponse] -> ShowS
GetServiceInstanceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceInstanceResponse] -> ShowS
$cshowList :: [GetServiceInstanceResponse] -> ShowS
show :: GetServiceInstanceResponse -> String
$cshow :: GetServiceInstanceResponse -> String
showsPrec :: Int -> GetServiceInstanceResponse -> ShowS
$cshowsPrec :: Int -> GetServiceInstanceResponse -> ShowS
Prelude.Show, forall x.
Rep GetServiceInstanceResponse x -> GetServiceInstanceResponse
forall x.
GetServiceInstanceResponse -> Rep GetServiceInstanceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServiceInstanceResponse x -> GetServiceInstanceResponse
$cfrom :: forall x.
GetServiceInstanceResponse -> Rep GetServiceInstanceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceInstanceResponse' 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', 'getServiceInstanceResponse_httpStatus' - The response's http status code.
--
-- 'serviceInstance', 'getServiceInstanceResponse_serviceInstance' - The detailed data of the requested service instance.
newGetServiceInstanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serviceInstance'
  ServiceInstance ->
  GetServiceInstanceResponse
newGetServiceInstanceResponse :: Int -> ServiceInstance -> GetServiceInstanceResponse
newGetServiceInstanceResponse
  Int
pHttpStatus_
  ServiceInstance
pServiceInstance_ =
    GetServiceInstanceResponse'
      { $sel:httpStatus:GetServiceInstanceResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:serviceInstance:GetServiceInstanceResponse' :: ServiceInstance
serviceInstance = ServiceInstance
pServiceInstance_
      }

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

-- | The detailed data of the requested service instance.
getServiceInstanceResponse_serviceInstance :: Lens.Lens' GetServiceInstanceResponse ServiceInstance
getServiceInstanceResponse_serviceInstance :: Lens' GetServiceInstanceResponse ServiceInstance
getServiceInstanceResponse_serviceInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceInstanceResponse' {ServiceInstance
serviceInstance :: ServiceInstance
$sel:serviceInstance:GetServiceInstanceResponse' :: GetServiceInstanceResponse -> ServiceInstance
serviceInstance} -> ServiceInstance
serviceInstance) (\s :: GetServiceInstanceResponse
s@GetServiceInstanceResponse' {} ServiceInstance
a -> GetServiceInstanceResponse
s {$sel:serviceInstance:GetServiceInstanceResponse' :: ServiceInstance
serviceInstance = ServiceInstance
a} :: GetServiceInstanceResponse)

instance Prelude.NFData GetServiceInstanceResponse where
  rnf :: GetServiceInstanceResponse -> ()
rnf GetServiceInstanceResponse' {Int
ServiceInstance
serviceInstance :: ServiceInstance
httpStatus :: Int
$sel:serviceInstance:GetServiceInstanceResponse' :: GetServiceInstanceResponse -> ServiceInstance
$sel:httpStatus:GetServiceInstanceResponse' :: GetServiceInstanceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServiceInstance
serviceInstance