{-# 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.EC2.MonitorInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables detailed monitoring for a running instance. Otherwise, basic
-- monitoring is enabled. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-cloudwatch.html Monitor your instances using CloudWatch>
-- in the /Amazon EC2 User Guide/.
--
-- To disable detailed monitoring, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_UnmonitorInstances.html UnmonitorInstances>.
module Amazonka.EC2.MonitorInstances
  ( -- * Creating a Request
    MonitorInstances (..),
    newMonitorInstances,

    -- * Request Lenses
    monitorInstances_dryRun,
    monitorInstances_instanceIds,

    -- * Destructuring the Response
    MonitorInstancesResponse (..),
    newMonitorInstancesResponse,

    -- * Response Lenses
    monitorInstancesResponse_instanceMonitorings,
    monitorInstancesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newMonitorInstances' smart constructor.
data MonitorInstances = MonitorInstances'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    MonitorInstances -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The IDs of the instances.
    MonitorInstances -> [Text]
instanceIds :: [Prelude.Text]
  }
  deriving (MonitorInstances -> MonitorInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorInstances -> MonitorInstances -> Bool
$c/= :: MonitorInstances -> MonitorInstances -> Bool
== :: MonitorInstances -> MonitorInstances -> Bool
$c== :: MonitorInstances -> MonitorInstances -> Bool
Prelude.Eq, ReadPrec [MonitorInstances]
ReadPrec MonitorInstances
Int -> ReadS MonitorInstances
ReadS [MonitorInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MonitorInstances]
$creadListPrec :: ReadPrec [MonitorInstances]
readPrec :: ReadPrec MonitorInstances
$creadPrec :: ReadPrec MonitorInstances
readList :: ReadS [MonitorInstances]
$creadList :: ReadS [MonitorInstances]
readsPrec :: Int -> ReadS MonitorInstances
$creadsPrec :: Int -> ReadS MonitorInstances
Prelude.Read, Int -> MonitorInstances -> ShowS
[MonitorInstances] -> ShowS
MonitorInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonitorInstances] -> ShowS
$cshowList :: [MonitorInstances] -> ShowS
show :: MonitorInstances -> String
$cshow :: MonitorInstances -> String
showsPrec :: Int -> MonitorInstances -> ShowS
$cshowsPrec :: Int -> MonitorInstances -> ShowS
Prelude.Show, forall x. Rep MonitorInstances x -> MonitorInstances
forall x. MonitorInstances -> Rep MonitorInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorInstances x -> MonitorInstances
$cfrom :: forall x. MonitorInstances -> Rep MonitorInstances x
Prelude.Generic)

-- |
-- Create a value of 'MonitorInstances' 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:
--
-- 'dryRun', 'monitorInstances_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'instanceIds', 'monitorInstances_instanceIds' - The IDs of the instances.
newMonitorInstances ::
  MonitorInstances
newMonitorInstances :: MonitorInstances
newMonitorInstances =
  MonitorInstances'
    { $sel:dryRun:MonitorInstances' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIds:MonitorInstances' :: [Text]
instanceIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
monitorInstances_dryRun :: Lens.Lens' MonitorInstances (Prelude.Maybe Prelude.Bool)
monitorInstances_dryRun :: Lens' MonitorInstances (Maybe Bool)
monitorInstances_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorInstances' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:MonitorInstances' :: MonitorInstances -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: MonitorInstances
s@MonitorInstances' {} Maybe Bool
a -> MonitorInstances
s {$sel:dryRun:MonitorInstances' :: Maybe Bool
dryRun = Maybe Bool
a} :: MonitorInstances)

-- | The IDs of the instances.
monitorInstances_instanceIds :: Lens.Lens' MonitorInstances [Prelude.Text]
monitorInstances_instanceIds :: Lens' MonitorInstances [Text]
monitorInstances_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorInstances' {[Text]
instanceIds :: [Text]
$sel:instanceIds:MonitorInstances' :: MonitorInstances -> [Text]
instanceIds} -> [Text]
instanceIds) (\s :: MonitorInstances
s@MonitorInstances' {} [Text]
a -> MonitorInstances
s {$sel:instanceIds:MonitorInstances' :: [Text]
instanceIds = [Text]
a} :: MonitorInstances) 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 MonitorInstances where
  type
    AWSResponse MonitorInstances =
      MonitorInstancesResponse
  request :: (Service -> Service)
-> MonitorInstances -> Request MonitorInstances
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy MonitorInstances
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse MonitorInstances)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [InstanceMonitoring] -> Int -> MonitorInstancesResponse
MonitorInstancesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instancesSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 MonitorInstances where
  hashWithSalt :: Int -> MonitorInstances -> Int
hashWithSalt Int
_salt MonitorInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
dryRun :: Maybe Bool
$sel:instanceIds:MonitorInstances' :: MonitorInstances -> [Text]
$sel:dryRun:MonitorInstances' :: MonitorInstances -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
instanceIds

instance Prelude.NFData MonitorInstances where
  rnf :: MonitorInstances -> ()
rnf MonitorInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
dryRun :: Maybe Bool
$sel:instanceIds:MonitorInstances' :: MonitorInstances -> [Text]
$sel:dryRun:MonitorInstances' :: MonitorInstances -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
instanceIds

instance Data.ToHeaders MonitorInstances where
  toHeaders :: MonitorInstances -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery MonitorInstances where
  toQuery :: MonitorInstances -> QueryString
toQuery MonitorInstances' {[Text]
Maybe Bool
instanceIds :: [Text]
dryRun :: Maybe Bool
$sel:instanceIds:MonitorInstances' :: MonitorInstances -> [Text]
$sel:dryRun:MonitorInstances' :: MonitorInstances -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"MonitorInstances" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"InstanceId" [Text]
instanceIds
      ]

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

-- |
-- Create a value of 'MonitorInstancesResponse' 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:
--
-- 'instanceMonitorings', 'monitorInstancesResponse_instanceMonitorings' - The monitoring information.
--
-- 'httpStatus', 'monitorInstancesResponse_httpStatus' - The response's http status code.
newMonitorInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MonitorInstancesResponse
newMonitorInstancesResponse :: Int -> MonitorInstancesResponse
newMonitorInstancesResponse Int
pHttpStatus_ =
  MonitorInstancesResponse'
    { $sel:instanceMonitorings:MonitorInstancesResponse' :: Maybe [InstanceMonitoring]
instanceMonitorings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MonitorInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The monitoring information.
monitorInstancesResponse_instanceMonitorings :: Lens.Lens' MonitorInstancesResponse (Prelude.Maybe [InstanceMonitoring])
monitorInstancesResponse_instanceMonitorings :: Lens' MonitorInstancesResponse (Maybe [InstanceMonitoring])
monitorInstancesResponse_instanceMonitorings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorInstancesResponse' {Maybe [InstanceMonitoring]
instanceMonitorings :: Maybe [InstanceMonitoring]
$sel:instanceMonitorings:MonitorInstancesResponse' :: MonitorInstancesResponse -> Maybe [InstanceMonitoring]
instanceMonitorings} -> Maybe [InstanceMonitoring]
instanceMonitorings) (\s :: MonitorInstancesResponse
s@MonitorInstancesResponse' {} Maybe [InstanceMonitoring]
a -> MonitorInstancesResponse
s {$sel:instanceMonitorings:MonitorInstancesResponse' :: Maybe [InstanceMonitoring]
instanceMonitorings = Maybe [InstanceMonitoring]
a} :: MonitorInstancesResponse) 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.
monitorInstancesResponse_httpStatus :: Lens.Lens' MonitorInstancesResponse Prelude.Int
monitorInstancesResponse_httpStatus :: Lens' MonitorInstancesResponse Int
monitorInstancesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MonitorInstancesResponse' {Int
httpStatus :: Int
$sel:httpStatus:MonitorInstancesResponse' :: MonitorInstancesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: MonitorInstancesResponse
s@MonitorInstancesResponse' {} Int
a -> MonitorInstancesResponse
s {$sel:httpStatus:MonitorInstancesResponse' :: Int
httpStatus = Int
a} :: MonitorInstancesResponse)

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