{-# 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.CodeDeploy.BatchGetOnPremisesInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about one or more on-premises instances. The maximum
-- number of on-premises instances that can be returned is 25.
module Amazonka.CodeDeploy.BatchGetOnPremisesInstances
  ( -- * Creating a Request
    BatchGetOnPremisesInstances (..),
    newBatchGetOnPremisesInstances,

    -- * Request Lenses
    batchGetOnPremisesInstances_instanceNames,

    -- * Destructuring the Response
    BatchGetOnPremisesInstancesResponse (..),
    newBatchGetOnPremisesInstancesResponse,

    -- * Response Lenses
    batchGetOnPremisesInstancesResponse_instanceInfos,
    batchGetOnPremisesInstancesResponse_httpStatus,
  )
where

import Amazonka.CodeDeploy.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input of a @BatchGetOnPremisesInstances@ operation.
--
-- /See:/ 'newBatchGetOnPremisesInstances' smart constructor.
data BatchGetOnPremisesInstances = BatchGetOnPremisesInstances'
  { -- | The names of the on-premises instances about which to get information.
    -- The maximum number of instance names you can specify is 25.
    BatchGetOnPremisesInstances -> [Text]
instanceNames :: [Prelude.Text]
  }
  deriving (BatchGetOnPremisesInstances -> BatchGetOnPremisesInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetOnPremisesInstances -> BatchGetOnPremisesInstances -> Bool
$c/= :: BatchGetOnPremisesInstances -> BatchGetOnPremisesInstances -> Bool
== :: BatchGetOnPremisesInstances -> BatchGetOnPremisesInstances -> Bool
$c== :: BatchGetOnPremisesInstances -> BatchGetOnPremisesInstances -> Bool
Prelude.Eq, ReadPrec [BatchGetOnPremisesInstances]
ReadPrec BatchGetOnPremisesInstances
Int -> ReadS BatchGetOnPremisesInstances
ReadS [BatchGetOnPremisesInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetOnPremisesInstances]
$creadListPrec :: ReadPrec [BatchGetOnPremisesInstances]
readPrec :: ReadPrec BatchGetOnPremisesInstances
$creadPrec :: ReadPrec BatchGetOnPremisesInstances
readList :: ReadS [BatchGetOnPremisesInstances]
$creadList :: ReadS [BatchGetOnPremisesInstances]
readsPrec :: Int -> ReadS BatchGetOnPremisesInstances
$creadsPrec :: Int -> ReadS BatchGetOnPremisesInstances
Prelude.Read, Int -> BatchGetOnPremisesInstances -> ShowS
[BatchGetOnPremisesInstances] -> ShowS
BatchGetOnPremisesInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetOnPremisesInstances] -> ShowS
$cshowList :: [BatchGetOnPremisesInstances] -> ShowS
show :: BatchGetOnPremisesInstances -> String
$cshow :: BatchGetOnPremisesInstances -> String
showsPrec :: Int -> BatchGetOnPremisesInstances -> ShowS
$cshowsPrec :: Int -> BatchGetOnPremisesInstances -> ShowS
Prelude.Show, forall x.
Rep BatchGetOnPremisesInstances x -> BatchGetOnPremisesInstances
forall x.
BatchGetOnPremisesInstances -> Rep BatchGetOnPremisesInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetOnPremisesInstances x -> BatchGetOnPremisesInstances
$cfrom :: forall x.
BatchGetOnPremisesInstances -> Rep BatchGetOnPremisesInstances x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetOnPremisesInstances' 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:
--
-- 'instanceNames', 'batchGetOnPremisesInstances_instanceNames' - The names of the on-premises instances about which to get information.
-- The maximum number of instance names you can specify is 25.
newBatchGetOnPremisesInstances ::
  BatchGetOnPremisesInstances
newBatchGetOnPremisesInstances :: BatchGetOnPremisesInstances
newBatchGetOnPremisesInstances =
  BatchGetOnPremisesInstances'
    { $sel:instanceNames:BatchGetOnPremisesInstances' :: [Text]
instanceNames =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The names of the on-premises instances about which to get information.
-- The maximum number of instance names you can specify is 25.
batchGetOnPremisesInstances_instanceNames :: Lens.Lens' BatchGetOnPremisesInstances [Prelude.Text]
batchGetOnPremisesInstances_instanceNames :: Lens' BatchGetOnPremisesInstances [Text]
batchGetOnPremisesInstances_instanceNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetOnPremisesInstances' {[Text]
instanceNames :: [Text]
$sel:instanceNames:BatchGetOnPremisesInstances' :: BatchGetOnPremisesInstances -> [Text]
instanceNames} -> [Text]
instanceNames) (\s :: BatchGetOnPremisesInstances
s@BatchGetOnPremisesInstances' {} [Text]
a -> BatchGetOnPremisesInstances
s {$sel:instanceNames:BatchGetOnPremisesInstances' :: [Text]
instanceNames = [Text]
a} :: BatchGetOnPremisesInstances) 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 BatchGetOnPremisesInstances where
  type
    AWSResponse BatchGetOnPremisesInstances =
      BatchGetOnPremisesInstancesResponse
  request :: (Service -> Service)
-> BatchGetOnPremisesInstances
-> Request BatchGetOnPremisesInstances
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 BatchGetOnPremisesInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetOnPremisesInstances)))
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 [InstanceInfo] -> Int -> BatchGetOnPremisesInstancesResponse
BatchGetOnPremisesInstancesResponse'
            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
"instanceInfos" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 BatchGetOnPremisesInstances where
  hashWithSalt :: Int -> BatchGetOnPremisesInstances -> Int
hashWithSalt Int
_salt BatchGetOnPremisesInstances' {[Text]
instanceNames :: [Text]
$sel:instanceNames:BatchGetOnPremisesInstances' :: BatchGetOnPremisesInstances -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
instanceNames

instance Prelude.NFData BatchGetOnPremisesInstances where
  rnf :: BatchGetOnPremisesInstances -> ()
rnf BatchGetOnPremisesInstances' {[Text]
instanceNames :: [Text]
$sel:instanceNames:BatchGetOnPremisesInstances' :: BatchGetOnPremisesInstances -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
instanceNames

instance Data.ToHeaders BatchGetOnPremisesInstances where
  toHeaders :: BatchGetOnPremisesInstances -> 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
"CodeDeploy_20141006.BatchGetOnPremisesInstances" ::
                          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 BatchGetOnPremisesInstances where
  toJSON :: BatchGetOnPremisesInstances -> Value
toJSON BatchGetOnPremisesInstances' {[Text]
instanceNames :: [Text]
$sel:instanceNames:BatchGetOnPremisesInstances' :: BatchGetOnPremisesInstances -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"instanceNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
instanceNames)
          ]
      )

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

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

-- | Represents the output of a @BatchGetOnPremisesInstances@ operation.
--
-- /See:/ 'newBatchGetOnPremisesInstancesResponse' smart constructor.
data BatchGetOnPremisesInstancesResponse = BatchGetOnPremisesInstancesResponse'
  { -- | Information about the on-premises instances.
    BatchGetOnPremisesInstancesResponse -> Maybe [InstanceInfo]
instanceInfos :: Prelude.Maybe [InstanceInfo],
    -- | The response's http status code.
    BatchGetOnPremisesInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetOnPremisesInstancesResponse
-> BatchGetOnPremisesInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetOnPremisesInstancesResponse
-> BatchGetOnPremisesInstancesResponse -> Bool
$c/= :: BatchGetOnPremisesInstancesResponse
-> BatchGetOnPremisesInstancesResponse -> Bool
== :: BatchGetOnPremisesInstancesResponse
-> BatchGetOnPremisesInstancesResponse -> Bool
$c== :: BatchGetOnPremisesInstancesResponse
-> BatchGetOnPremisesInstancesResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetOnPremisesInstancesResponse]
ReadPrec BatchGetOnPremisesInstancesResponse
Int -> ReadS BatchGetOnPremisesInstancesResponse
ReadS [BatchGetOnPremisesInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetOnPremisesInstancesResponse]
$creadListPrec :: ReadPrec [BatchGetOnPremisesInstancesResponse]
readPrec :: ReadPrec BatchGetOnPremisesInstancesResponse
$creadPrec :: ReadPrec BatchGetOnPremisesInstancesResponse
readList :: ReadS [BatchGetOnPremisesInstancesResponse]
$creadList :: ReadS [BatchGetOnPremisesInstancesResponse]
readsPrec :: Int -> ReadS BatchGetOnPremisesInstancesResponse
$creadsPrec :: Int -> ReadS BatchGetOnPremisesInstancesResponse
Prelude.Read, Int -> BatchGetOnPremisesInstancesResponse -> ShowS
[BatchGetOnPremisesInstancesResponse] -> ShowS
BatchGetOnPremisesInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetOnPremisesInstancesResponse] -> ShowS
$cshowList :: [BatchGetOnPremisesInstancesResponse] -> ShowS
show :: BatchGetOnPremisesInstancesResponse -> String
$cshow :: BatchGetOnPremisesInstancesResponse -> String
showsPrec :: Int -> BatchGetOnPremisesInstancesResponse -> ShowS
$cshowsPrec :: Int -> BatchGetOnPremisesInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetOnPremisesInstancesResponse x
-> BatchGetOnPremisesInstancesResponse
forall x.
BatchGetOnPremisesInstancesResponse
-> Rep BatchGetOnPremisesInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetOnPremisesInstancesResponse x
-> BatchGetOnPremisesInstancesResponse
$cfrom :: forall x.
BatchGetOnPremisesInstancesResponse
-> Rep BatchGetOnPremisesInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetOnPremisesInstancesResponse' 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:
--
-- 'instanceInfos', 'batchGetOnPremisesInstancesResponse_instanceInfos' - Information about the on-premises instances.
--
-- 'httpStatus', 'batchGetOnPremisesInstancesResponse_httpStatus' - The response's http status code.
newBatchGetOnPremisesInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetOnPremisesInstancesResponse
newBatchGetOnPremisesInstancesResponse :: Int -> BatchGetOnPremisesInstancesResponse
newBatchGetOnPremisesInstancesResponse Int
pHttpStatus_ =
  BatchGetOnPremisesInstancesResponse'
    { $sel:instanceInfos:BatchGetOnPremisesInstancesResponse' :: Maybe [InstanceInfo]
instanceInfos =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetOnPremisesInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the on-premises instances.
batchGetOnPremisesInstancesResponse_instanceInfos :: Lens.Lens' BatchGetOnPremisesInstancesResponse (Prelude.Maybe [InstanceInfo])
batchGetOnPremisesInstancesResponse_instanceInfos :: Lens' BatchGetOnPremisesInstancesResponse (Maybe [InstanceInfo])
batchGetOnPremisesInstancesResponse_instanceInfos = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetOnPremisesInstancesResponse' {Maybe [InstanceInfo]
instanceInfos :: Maybe [InstanceInfo]
$sel:instanceInfos:BatchGetOnPremisesInstancesResponse' :: BatchGetOnPremisesInstancesResponse -> Maybe [InstanceInfo]
instanceInfos} -> Maybe [InstanceInfo]
instanceInfos) (\s :: BatchGetOnPremisesInstancesResponse
s@BatchGetOnPremisesInstancesResponse' {} Maybe [InstanceInfo]
a -> BatchGetOnPremisesInstancesResponse
s {$sel:instanceInfos:BatchGetOnPremisesInstancesResponse' :: Maybe [InstanceInfo]
instanceInfos = Maybe [InstanceInfo]
a} :: BatchGetOnPremisesInstancesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    BatchGetOnPremisesInstancesResponse
  where
  rnf :: BatchGetOnPremisesInstancesResponse -> ()
rnf BatchGetOnPremisesInstancesResponse' {Int
Maybe [InstanceInfo]
httpStatus :: Int
instanceInfos :: Maybe [InstanceInfo]
$sel:httpStatus:BatchGetOnPremisesInstancesResponse' :: BatchGetOnPremisesInstancesResponse -> Int
$sel:instanceInfos:BatchGetOnPremisesInstancesResponse' :: BatchGetOnPremisesInstancesResponse -> Maybe [InstanceInfo]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceInfo]
instanceInfos
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus