{-# 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.CreateContainer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a storage container to hold objects. A container is similar to a
-- bucket in the Amazon S3 service.
module Amazonka.MediaStore.CreateContainer
  ( -- * Creating a Request
    CreateContainer (..),
    newCreateContainer,

    -- * Request Lenses
    createContainer_tags,
    createContainer_containerName,

    -- * Destructuring the Response
    CreateContainerResponse (..),
    newCreateContainerResponse,

    -- * Response Lenses
    createContainerResponse_httpStatus,
    createContainerResponse_container,
  )
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:/ 'newCreateContainer' smart constructor.
data CreateContainer = CreateContainer'
  { -- | An array of key:value pairs that you define. These values can be
    -- anything that you want. Typically, the tag key represents a category
    -- (such as \"environment\") and the tag value represents a specific value
    -- within that category (such as \"test,\" \"development,\" or
    -- \"production\"). You can add up to 50 tags to each container. For more
    -- information about tagging, including naming and usage conventions, see
    -- <https://docs.aws.amazon.com/mediastore/latest/ug/tagging.html Tagging Resources in MediaStore>.
    CreateContainer -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name for the container. The name must be from 1 to 255 characters.
    -- Container names must be unique to your AWS account within a specific
    -- region. As an example, you could create a container named @movies@ in
    -- every region, as long as you don’t have an existing container with that
    -- name.
    CreateContainer -> Text
containerName :: Prelude.Text
  }
  deriving (CreateContainer -> CreateContainer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContainer -> CreateContainer -> Bool
$c/= :: CreateContainer -> CreateContainer -> Bool
== :: CreateContainer -> CreateContainer -> Bool
$c== :: CreateContainer -> CreateContainer -> Bool
Prelude.Eq, ReadPrec [CreateContainer]
ReadPrec CreateContainer
Int -> ReadS CreateContainer
ReadS [CreateContainer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContainer]
$creadListPrec :: ReadPrec [CreateContainer]
readPrec :: ReadPrec CreateContainer
$creadPrec :: ReadPrec CreateContainer
readList :: ReadS [CreateContainer]
$creadList :: ReadS [CreateContainer]
readsPrec :: Int -> ReadS CreateContainer
$creadsPrec :: Int -> ReadS CreateContainer
Prelude.Read, Int -> CreateContainer -> ShowS
[CreateContainer] -> ShowS
CreateContainer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContainer] -> ShowS
$cshowList :: [CreateContainer] -> ShowS
show :: CreateContainer -> String
$cshow :: CreateContainer -> String
showsPrec :: Int -> CreateContainer -> ShowS
$cshowsPrec :: Int -> CreateContainer -> ShowS
Prelude.Show, forall x. Rep CreateContainer x -> CreateContainer
forall x. CreateContainer -> Rep CreateContainer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContainer x -> CreateContainer
$cfrom :: forall x. CreateContainer -> Rep CreateContainer x
Prelude.Generic)

-- |
-- Create a value of 'CreateContainer' 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:
--
-- 'tags', 'createContainer_tags' - An array of key:value pairs that you define. These values can be
-- anything that you want. Typically, the tag key represents a category
-- (such as \"environment\") and the tag value represents a specific value
-- within that category (such as \"test,\" \"development,\" or
-- \"production\"). You can add up to 50 tags to each container. For more
-- information about tagging, including naming and usage conventions, see
-- <https://docs.aws.amazon.com/mediastore/latest/ug/tagging.html Tagging Resources in MediaStore>.
--
-- 'containerName', 'createContainer_containerName' - The name for the container. The name must be from 1 to 255 characters.
-- Container names must be unique to your AWS account within a specific
-- region. As an example, you could create a container named @movies@ in
-- every region, as long as you don’t have an existing container with that
-- name.
newCreateContainer ::
  -- | 'containerName'
  Prelude.Text ->
  CreateContainer
newCreateContainer :: Text -> CreateContainer
newCreateContainer Text
pContainerName_ =
  CreateContainer'
    { $sel:tags:CreateContainer' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:containerName:CreateContainer' :: Text
containerName = Text
pContainerName_
    }

-- | An array of key:value pairs that you define. These values can be
-- anything that you want. Typically, the tag key represents a category
-- (such as \"environment\") and the tag value represents a specific value
-- within that category (such as \"test,\" \"development,\" or
-- \"production\"). You can add up to 50 tags to each container. For more
-- information about tagging, including naming and usage conventions, see
-- <https://docs.aws.amazon.com/mediastore/latest/ug/tagging.html Tagging Resources in MediaStore>.
createContainer_tags :: Lens.Lens' CreateContainer (Prelude.Maybe (Prelude.NonEmpty Tag))
createContainer_tags :: Lens' CreateContainer (Maybe (NonEmpty Tag))
createContainer_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainer' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateContainer' :: CreateContainer -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateContainer
s@CreateContainer' {} Maybe (NonEmpty Tag)
a -> CreateContainer
s {$sel:tags:CreateContainer' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateContainer) 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 name for the container. The name must be from 1 to 255 characters.
-- Container names must be unique to your AWS account within a specific
-- region. As an example, you could create a container named @movies@ in
-- every region, as long as you don’t have an existing container with that
-- name.
createContainer_containerName :: Lens.Lens' CreateContainer Prelude.Text
createContainer_containerName :: Lens' CreateContainer Text
createContainer_containerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainer' {Text
containerName :: Text
$sel:containerName:CreateContainer' :: CreateContainer -> Text
containerName} -> Text
containerName) (\s :: CreateContainer
s@CreateContainer' {} Text
a -> CreateContainer
s {$sel:containerName:CreateContainer' :: Text
containerName = Text
a} :: CreateContainer)

instance Core.AWSRequest CreateContainer where
  type
    AWSResponse CreateContainer =
      CreateContainerResponse
  request :: (Service -> Service) -> CreateContainer -> Request CreateContainer
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 CreateContainer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateContainer)))
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 -> Container -> CreateContainerResponse
CreateContainerResponse'
            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
"Container")
      )

instance Prelude.Hashable CreateContainer where
  hashWithSalt :: Int -> CreateContainer -> Int
hashWithSalt Int
_salt CreateContainer' {Maybe (NonEmpty Tag)
Text
containerName :: Text
tags :: Maybe (NonEmpty Tag)
$sel:containerName:CreateContainer' :: CreateContainer -> Text
$sel:tags:CreateContainer' :: CreateContainer -> Maybe (NonEmpty Tag)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
containerName

instance Prelude.NFData CreateContainer where
  rnf :: CreateContainer -> ()
rnf CreateContainer' {Maybe (NonEmpty Tag)
Text
containerName :: Text
tags :: Maybe (NonEmpty Tag)
$sel:containerName:CreateContainer' :: CreateContainer -> Text
$sel:tags:CreateContainer' :: CreateContainer -> Maybe (NonEmpty Tag)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
containerName

instance Data.ToHeaders CreateContainer where
  toHeaders :: CreateContainer -> 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.CreateContainer" ::
                          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 CreateContainer where
  toJSON :: CreateContainer -> Value
toJSON CreateContainer' {Maybe (NonEmpty Tag)
Text
containerName :: Text
tags :: Maybe (NonEmpty Tag)
$sel:containerName:CreateContainer' :: CreateContainer -> Text
$sel:tags:CreateContainer' :: CreateContainer -> Maybe (NonEmpty Tag)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ContainerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
containerName)
          ]
      )

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

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

-- | /See:/ 'newCreateContainerResponse' smart constructor.
data CreateContainerResponse = CreateContainerResponse'
  { -- | The response's http status code.
    CreateContainerResponse -> Int
httpStatus :: Prelude.Int,
    -- | ContainerARN: The Amazon Resource Name (ARN) of the newly created
    -- container. The ARN has the following format: arn:aws:\<region>:\<account
    -- that owns this container>:container\/\<name of container>. For example:
    -- arn:aws:mediastore:us-west-2:111122223333:container\/movies
    --
    -- ContainerName: The container name as specified in the request.
    --
    -- CreationTime: Unix time stamp.
    --
    -- Status: The status of container creation or deletion. The status is one
    -- of the following: @CREATING@, @ACTIVE@, or @DELETING@. While the service
    -- is creating the container, the status is @CREATING@. When an endpoint is
    -- available, the status changes to @ACTIVE@.
    --
    -- The return value does not include the container\'s endpoint. To make
    -- downstream requests, you must obtain this value by using
    -- DescribeContainer or ListContainers.
    CreateContainerResponse -> Container
container :: Container
  }
  deriving (CreateContainerResponse -> CreateContainerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContainerResponse -> CreateContainerResponse -> Bool
$c/= :: CreateContainerResponse -> CreateContainerResponse -> Bool
== :: CreateContainerResponse -> CreateContainerResponse -> Bool
$c== :: CreateContainerResponse -> CreateContainerResponse -> Bool
Prelude.Eq, ReadPrec [CreateContainerResponse]
ReadPrec CreateContainerResponse
Int -> ReadS CreateContainerResponse
ReadS [CreateContainerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContainerResponse]
$creadListPrec :: ReadPrec [CreateContainerResponse]
readPrec :: ReadPrec CreateContainerResponse
$creadPrec :: ReadPrec CreateContainerResponse
readList :: ReadS [CreateContainerResponse]
$creadList :: ReadS [CreateContainerResponse]
readsPrec :: Int -> ReadS CreateContainerResponse
$creadsPrec :: Int -> ReadS CreateContainerResponse
Prelude.Read, Int -> CreateContainerResponse -> ShowS
[CreateContainerResponse] -> ShowS
CreateContainerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContainerResponse] -> ShowS
$cshowList :: [CreateContainerResponse] -> ShowS
show :: CreateContainerResponse -> String
$cshow :: CreateContainerResponse -> String
showsPrec :: Int -> CreateContainerResponse -> ShowS
$cshowsPrec :: Int -> CreateContainerResponse -> ShowS
Prelude.Show, forall x. Rep CreateContainerResponse x -> CreateContainerResponse
forall x. CreateContainerResponse -> Rep CreateContainerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContainerResponse x -> CreateContainerResponse
$cfrom :: forall x. CreateContainerResponse -> Rep CreateContainerResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateContainerResponse' 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', 'createContainerResponse_httpStatus' - The response's http status code.
--
-- 'container', 'createContainerResponse_container' - ContainerARN: The Amazon Resource Name (ARN) of the newly created
-- container. The ARN has the following format: arn:aws:\<region>:\<account
-- that owns this container>:container\/\<name of container>. For example:
-- arn:aws:mediastore:us-west-2:111122223333:container\/movies
--
-- ContainerName: The container name as specified in the request.
--
-- CreationTime: Unix time stamp.
--
-- Status: The status of container creation or deletion. The status is one
-- of the following: @CREATING@, @ACTIVE@, or @DELETING@. While the service
-- is creating the container, the status is @CREATING@. When an endpoint is
-- available, the status changes to @ACTIVE@.
--
-- The return value does not include the container\'s endpoint. To make
-- downstream requests, you must obtain this value by using
-- DescribeContainer or ListContainers.
newCreateContainerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'container'
  Container ->
  CreateContainerResponse
newCreateContainerResponse :: Int -> Container -> CreateContainerResponse
newCreateContainerResponse Int
pHttpStatus_ Container
pContainer_ =
  CreateContainerResponse'
    { $sel:httpStatus:CreateContainerResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:container:CreateContainerResponse' :: Container
container = Container
pContainer_
    }

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

-- | ContainerARN: The Amazon Resource Name (ARN) of the newly created
-- container. The ARN has the following format: arn:aws:\<region>:\<account
-- that owns this container>:container\/\<name of container>. For example:
-- arn:aws:mediastore:us-west-2:111122223333:container\/movies
--
-- ContainerName: The container name as specified in the request.
--
-- CreationTime: Unix time stamp.
--
-- Status: The status of container creation or deletion. The status is one
-- of the following: @CREATING@, @ACTIVE@, or @DELETING@. While the service
-- is creating the container, the status is @CREATING@. When an endpoint is
-- available, the status changes to @ACTIVE@.
--
-- The return value does not include the container\'s endpoint. To make
-- downstream requests, you must obtain this value by using
-- DescribeContainer or ListContainers.
createContainerResponse_container :: Lens.Lens' CreateContainerResponse Container
createContainerResponse_container :: Lens' CreateContainerResponse Container
createContainerResponse_container = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerResponse' {Container
container :: Container
$sel:container:CreateContainerResponse' :: CreateContainerResponse -> Container
container} -> Container
container) (\s :: CreateContainerResponse
s@CreateContainerResponse' {} Container
a -> CreateContainerResponse
s {$sel:container:CreateContainerResponse' :: Container
container = Container
a} :: CreateContainerResponse)

instance Prelude.NFData CreateContainerResponse where
  rnf :: CreateContainerResponse -> ()
rnf CreateContainerResponse' {Int
Container
container :: Container
httpStatus :: Int
$sel:container:CreateContainerResponse' :: CreateContainerResponse -> Container
$sel:httpStatus:CreateContainerResponse' :: CreateContainerResponse -> 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 Container
container