{-# 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.PutCorsPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the cross-origin resource sharing (CORS) configuration on a
-- container so that the container can service cross-origin requests. For
-- example, you might want to enable a request whose origin is
-- http:\/\/www.example.com to access your AWS Elemental MediaStore
-- container at my.example.container.com by using the browser\'s
-- XMLHttpRequest capability.
--
-- To enable CORS on a container, you attach a CORS policy to the
-- container. In the CORS policy, you configure rules that identify origins
-- and the HTTP methods that can be executed on your container. The policy
-- can contain up to 398,000 characters. You can add up to 100 rules to a
-- CORS policy. If more than one rule applies, the service uses the first
-- applicable rule listed.
--
-- To learn more about CORS, see
-- <https://docs.aws.amazon.com/mediastore/latest/ug/cors-policy.html Cross-Origin Resource Sharing (CORS) in AWS Elemental MediaStore>.
module Amazonka.MediaStore.PutCorsPolicy
  ( -- * Creating a Request
    PutCorsPolicy (..),
    newPutCorsPolicy,

    -- * Request Lenses
    putCorsPolicy_containerName,
    putCorsPolicy_corsPolicy,

    -- * Destructuring the Response
    PutCorsPolicyResponse (..),
    newPutCorsPolicyResponse,

    -- * Response Lenses
    putCorsPolicyResponse_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:/ 'newPutCorsPolicy' smart constructor.
data PutCorsPolicy = PutCorsPolicy'
  { -- | The name of the container that you want to assign the CORS policy to.
    PutCorsPolicy -> Text
containerName :: Prelude.Text,
    -- | The CORS policy to apply to the container.
    PutCorsPolicy -> NonEmpty CorsRule
corsPolicy :: Prelude.NonEmpty CorsRule
  }
  deriving (PutCorsPolicy -> PutCorsPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutCorsPolicy -> PutCorsPolicy -> Bool
$c/= :: PutCorsPolicy -> PutCorsPolicy -> Bool
== :: PutCorsPolicy -> PutCorsPolicy -> Bool
$c== :: PutCorsPolicy -> PutCorsPolicy -> Bool
Prelude.Eq, ReadPrec [PutCorsPolicy]
ReadPrec PutCorsPolicy
Int -> ReadS PutCorsPolicy
ReadS [PutCorsPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutCorsPolicy]
$creadListPrec :: ReadPrec [PutCorsPolicy]
readPrec :: ReadPrec PutCorsPolicy
$creadPrec :: ReadPrec PutCorsPolicy
readList :: ReadS [PutCorsPolicy]
$creadList :: ReadS [PutCorsPolicy]
readsPrec :: Int -> ReadS PutCorsPolicy
$creadsPrec :: Int -> ReadS PutCorsPolicy
Prelude.Read, Int -> PutCorsPolicy -> ShowS
[PutCorsPolicy] -> ShowS
PutCorsPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutCorsPolicy] -> ShowS
$cshowList :: [PutCorsPolicy] -> ShowS
show :: PutCorsPolicy -> String
$cshow :: PutCorsPolicy -> String
showsPrec :: Int -> PutCorsPolicy -> ShowS
$cshowsPrec :: Int -> PutCorsPolicy -> ShowS
Prelude.Show, forall x. Rep PutCorsPolicy x -> PutCorsPolicy
forall x. PutCorsPolicy -> Rep PutCorsPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutCorsPolicy x -> PutCorsPolicy
$cfrom :: forall x. PutCorsPolicy -> Rep PutCorsPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutCorsPolicy' 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', 'putCorsPolicy_containerName' - The name of the container that you want to assign the CORS policy to.
--
-- 'corsPolicy', 'putCorsPolicy_corsPolicy' - The CORS policy to apply to the container.
newPutCorsPolicy ::
  -- | 'containerName'
  Prelude.Text ->
  -- | 'corsPolicy'
  Prelude.NonEmpty CorsRule ->
  PutCorsPolicy
newPutCorsPolicy :: Text -> NonEmpty CorsRule -> PutCorsPolicy
newPutCorsPolicy Text
pContainerName_ NonEmpty CorsRule
pCorsPolicy_ =
  PutCorsPolicy'
    { $sel:containerName:PutCorsPolicy' :: Text
containerName = Text
pContainerName_,
      $sel:corsPolicy:PutCorsPolicy' :: NonEmpty CorsRule
corsPolicy = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty CorsRule
pCorsPolicy_
    }

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

-- | The CORS policy to apply to the container.
putCorsPolicy_corsPolicy :: Lens.Lens' PutCorsPolicy (Prelude.NonEmpty CorsRule)
putCorsPolicy_corsPolicy :: Lens' PutCorsPolicy (NonEmpty CorsRule)
putCorsPolicy_corsPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutCorsPolicy' {NonEmpty CorsRule
corsPolicy :: NonEmpty CorsRule
$sel:corsPolicy:PutCorsPolicy' :: PutCorsPolicy -> NonEmpty CorsRule
corsPolicy} -> NonEmpty CorsRule
corsPolicy) (\s :: PutCorsPolicy
s@PutCorsPolicy' {} NonEmpty CorsRule
a -> PutCorsPolicy
s {$sel:corsPolicy:PutCorsPolicy' :: NonEmpty CorsRule
corsPolicy = NonEmpty CorsRule
a} :: PutCorsPolicy) 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 PutCorsPolicy where
  type
    AWSResponse PutCorsPolicy =
      PutCorsPolicyResponse
  request :: (Service -> Service) -> PutCorsPolicy -> Request PutCorsPolicy
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 PutCorsPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutCorsPolicy)))
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 -> PutCorsPolicyResponse
PutCorsPolicyResponse'
            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 PutCorsPolicy where
  hashWithSalt :: Int -> PutCorsPolicy -> Int
hashWithSalt Int
_salt PutCorsPolicy' {NonEmpty CorsRule
Text
corsPolicy :: NonEmpty CorsRule
containerName :: Text
$sel:corsPolicy:PutCorsPolicy' :: PutCorsPolicy -> NonEmpty CorsRule
$sel:containerName:PutCorsPolicy' :: PutCorsPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
containerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CorsRule
corsPolicy

instance Prelude.NFData PutCorsPolicy where
  rnf :: PutCorsPolicy -> ()
rnf PutCorsPolicy' {NonEmpty CorsRule
Text
corsPolicy :: NonEmpty CorsRule
containerName :: Text
$sel:corsPolicy:PutCorsPolicy' :: PutCorsPolicy -> NonEmpty CorsRule
$sel:containerName:PutCorsPolicy' :: PutCorsPolicy -> 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 NonEmpty CorsRule
corsPolicy

instance Data.ToHeaders PutCorsPolicy where
  toHeaders :: PutCorsPolicy -> 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.PutCorsPolicy" ::
                          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 PutCorsPolicy where
  toJSON :: PutCorsPolicy -> Value
toJSON PutCorsPolicy' {NonEmpty CorsRule
Text
corsPolicy :: NonEmpty CorsRule
containerName :: Text
$sel:corsPolicy:PutCorsPolicy' :: PutCorsPolicy -> NonEmpty CorsRule
$sel:containerName:PutCorsPolicy' :: PutCorsPolicy -> 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
"CorsPolicy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CorsRule
corsPolicy)
          ]
      )

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

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

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

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

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

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