{-# 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.MediaStore.PutMetricPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The metric policy that you want to add to the container. A metric policy
-- allows AWS Elemental MediaStore to send metrics to Amazon CloudWatch. It
-- takes up to 20 minutes for the new policy to take effect.
module Amazonka.MediaStore.PutMetricPolicy
  ( -- * Creating a Request
    PutMetricPolicy (..),
    newPutMetricPolicy,

    -- * Request Lenses
    putMetricPolicy_containerName,
    putMetricPolicy_metricPolicy,

    -- * Destructuring the Response
    PutMetricPolicyResponse (..),
    newPutMetricPolicyResponse,

    -- * Response Lenses
    putMetricPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutMetricPolicy' smart constructor.
data PutMetricPolicy = PutMetricPolicy'
  { -- | The name of the container that you want to add the metric policy to.
    PutMetricPolicy -> Text
containerName :: Prelude.Text,
    -- | The metric policy that you want to associate with the container. In the
    -- policy, you must indicate whether you want MediaStore to send
    -- container-level metrics. You can also include up to five rules to define
    -- groups of objects that you want MediaStore to send object-level metrics
    -- for. If you include rules in the policy, construct each rule with both
    -- of the following:
    --
    -- -   An object group that defines which objects to include in the group.
    --     The definition can be a path or a file name, but it can\'t have more
    --     than 900 characters. Valid characters are: a-z, A-Z, 0-9, _
    --     (underscore), = (equal), : (colon), . (period), - (hyphen), ~
    --     (tilde), \/ (forward slash), and * (asterisk). Wildcards (*) are
    --     acceptable.
    --
    -- -   An object group name that allows you to refer to the object group.
    --     The name can\'t have more than 30 characters. Valid characters are:
    --     a-z, A-Z, 0-9, and _ (underscore).
    PutMetricPolicy -> MetricPolicy
metricPolicy :: MetricPolicy
  }
  deriving (PutMetricPolicy -> PutMetricPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricPolicy -> PutMetricPolicy -> Bool
$c/= :: PutMetricPolicy -> PutMetricPolicy -> Bool
== :: PutMetricPolicy -> PutMetricPolicy -> Bool
$c== :: PutMetricPolicy -> PutMetricPolicy -> Bool
Prelude.Eq, ReadPrec [PutMetricPolicy]
ReadPrec PutMetricPolicy
Int -> ReadS PutMetricPolicy
ReadS [PutMetricPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricPolicy]
$creadListPrec :: ReadPrec [PutMetricPolicy]
readPrec :: ReadPrec PutMetricPolicy
$creadPrec :: ReadPrec PutMetricPolicy
readList :: ReadS [PutMetricPolicy]
$creadList :: ReadS [PutMetricPolicy]
readsPrec :: Int -> ReadS PutMetricPolicy
$creadsPrec :: Int -> ReadS PutMetricPolicy
Prelude.Read, Int -> PutMetricPolicy -> ShowS
[PutMetricPolicy] -> ShowS
PutMetricPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricPolicy] -> ShowS
$cshowList :: [PutMetricPolicy] -> ShowS
show :: PutMetricPolicy -> String
$cshow :: PutMetricPolicy -> String
showsPrec :: Int -> PutMetricPolicy -> ShowS
$cshowsPrec :: Int -> PutMetricPolicy -> ShowS
Prelude.Show, forall x. Rep PutMetricPolicy x -> PutMetricPolicy
forall x. PutMetricPolicy -> Rep PutMetricPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricPolicy x -> PutMetricPolicy
$cfrom :: forall x. PutMetricPolicy -> Rep PutMetricPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricPolicy' 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:
--
-- 'containerName', 'putMetricPolicy_containerName' - The name of the container that you want to add the metric policy to.
--
-- 'metricPolicy', 'putMetricPolicy_metricPolicy' - The metric policy that you want to associate with the container. In the
-- policy, you must indicate whether you want MediaStore to send
-- container-level metrics. You can also include up to five rules to define
-- groups of objects that you want MediaStore to send object-level metrics
-- for. If you include rules in the policy, construct each rule with both
-- of the following:
--
-- -   An object group that defines which objects to include in the group.
--     The definition can be a path or a file name, but it can\'t have more
--     than 900 characters. Valid characters are: a-z, A-Z, 0-9, _
--     (underscore), = (equal), : (colon), . (period), - (hyphen), ~
--     (tilde), \/ (forward slash), and * (asterisk). Wildcards (*) are
--     acceptable.
--
-- -   An object group name that allows you to refer to the object group.
--     The name can\'t have more than 30 characters. Valid characters are:
--     a-z, A-Z, 0-9, and _ (underscore).
newPutMetricPolicy ::
  -- | 'containerName'
  Prelude.Text ->
  -- | 'metricPolicy'
  MetricPolicy ->
  PutMetricPolicy
newPutMetricPolicy :: Text -> MetricPolicy -> PutMetricPolicy
newPutMetricPolicy Text
pContainerName_ MetricPolicy
pMetricPolicy_ =
  PutMetricPolicy'
    { $sel:containerName:PutMetricPolicy' :: Text
containerName = Text
pContainerName_,
      $sel:metricPolicy:PutMetricPolicy' :: MetricPolicy
metricPolicy = MetricPolicy
pMetricPolicy_
    }

-- | The name of the container that you want to add the metric policy to.
putMetricPolicy_containerName :: Lens.Lens' PutMetricPolicy Prelude.Text
putMetricPolicy_containerName :: Lens' PutMetricPolicy Text
putMetricPolicy_containerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricPolicy' {Text
containerName :: Text
$sel:containerName:PutMetricPolicy' :: PutMetricPolicy -> Text
containerName} -> Text
containerName) (\s :: PutMetricPolicy
s@PutMetricPolicy' {} Text
a -> PutMetricPolicy
s {$sel:containerName:PutMetricPolicy' :: Text
containerName = Text
a} :: PutMetricPolicy)

-- | The metric policy that you want to associate with the container. In the
-- policy, you must indicate whether you want MediaStore to send
-- container-level metrics. You can also include up to five rules to define
-- groups of objects that you want MediaStore to send object-level metrics
-- for. If you include rules in the policy, construct each rule with both
-- of the following:
--
-- -   An object group that defines which objects to include in the group.
--     The definition can be a path or a file name, but it can\'t have more
--     than 900 characters. Valid characters are: a-z, A-Z, 0-9, _
--     (underscore), = (equal), : (colon), . (period), - (hyphen), ~
--     (tilde), \/ (forward slash), and * (asterisk). Wildcards (*) are
--     acceptable.
--
-- -   An object group name that allows you to refer to the object group.
--     The name can\'t have more than 30 characters. Valid characters are:
--     a-z, A-Z, 0-9, and _ (underscore).
putMetricPolicy_metricPolicy :: Lens.Lens' PutMetricPolicy MetricPolicy
putMetricPolicy_metricPolicy :: Lens' PutMetricPolicy MetricPolicy
putMetricPolicy_metricPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricPolicy' {MetricPolicy
metricPolicy :: MetricPolicy
$sel:metricPolicy:PutMetricPolicy' :: PutMetricPolicy -> MetricPolicy
metricPolicy} -> MetricPolicy
metricPolicy) (\s :: PutMetricPolicy
s@PutMetricPolicy' {} MetricPolicy
a -> PutMetricPolicy
s {$sel:metricPolicy:PutMetricPolicy' :: MetricPolicy
metricPolicy = MetricPolicy
a} :: PutMetricPolicy)

instance Core.AWSRequest PutMetricPolicy where
  type
    AWSResponse PutMetricPolicy =
      PutMetricPolicyResponse
  request :: (Service -> Service) -> PutMetricPolicy -> Request PutMetricPolicy
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 PutMetricPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutMetricPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutMetricPolicyResponse
PutMetricPolicyResponse'
            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))
      )

instance Prelude.Hashable PutMetricPolicy where
  hashWithSalt :: Int -> PutMetricPolicy -> Int
hashWithSalt Int
_salt PutMetricPolicy' {Text
MetricPolicy
metricPolicy :: MetricPolicy
containerName :: Text
$sel:metricPolicy:PutMetricPolicy' :: PutMetricPolicy -> MetricPolicy
$sel:containerName:PutMetricPolicy' :: PutMetricPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
containerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricPolicy
metricPolicy

instance Prelude.NFData PutMetricPolicy where
  rnf :: PutMetricPolicy -> ()
rnf PutMetricPolicy' {Text
MetricPolicy
metricPolicy :: MetricPolicy
containerName :: Text
$sel:metricPolicy:PutMetricPolicy' :: PutMetricPolicy -> MetricPolicy
$sel:containerName:PutMetricPolicy' :: PutMetricPolicy -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
containerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricPolicy
metricPolicy

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

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

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

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

-- |
-- Create a value of 'PutMetricPolicyResponse' 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', 'putMetricPolicyResponse_httpStatus' - The response's http status code.
newPutMetricPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutMetricPolicyResponse
newPutMetricPolicyResponse :: Int -> PutMetricPolicyResponse
newPutMetricPolicyResponse Int
pHttpStatus_ =
  PutMetricPolicyResponse' {$sel:httpStatus:PutMetricPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData PutMetricPolicyResponse where
  rnf :: PutMetricPolicyResponse -> ()
rnf PutMetricPolicyResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutMetricPolicyResponse' :: PutMetricPolicyResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus