{-# 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.Rekognition.CreateCollection
-- 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 collection in an AWS Region. You can add faces to the
-- collection using the IndexFaces operation.
--
-- For example, you might create collections, one for each of your
-- application users. A user can then index faces using the @IndexFaces@
-- operation and persist results in a specific collection. Then, a user can
-- search the collection for faces in the user-specific container.
--
-- When you create a collection, it is associated with the latest version
-- of the face model version.
--
-- Collection names are case-sensitive.
--
-- This operation requires permissions to perform the
-- @rekognition:CreateCollection@ action. If you want to tag your
-- collection, you also require permission to perform the
-- @rekognition:TagResource@ operation.
module Amazonka.Rekognition.CreateCollection
  ( -- * Creating a Request
    CreateCollection (..),
    newCreateCollection,

    -- * Request Lenses
    createCollection_tags,
    createCollection_collectionId,

    -- * Destructuring the Response
    CreateCollectionResponse (..),
    newCreateCollectionResponse,

    -- * Response Lenses
    createCollectionResponse_collectionArn,
    createCollectionResponse_faceModelVersion,
    createCollectionResponse_statusCode,
    createCollectionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateCollection' smart constructor.
data CreateCollection = CreateCollection'
  { -- | A set of tags (key-value pairs) that you want to attach to the
    -- collection.
    CreateCollection -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | ID for the collection that you are creating.
    CreateCollection -> Text
collectionId :: Prelude.Text
  }
  deriving (CreateCollection -> CreateCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCollection -> CreateCollection -> Bool
$c/= :: CreateCollection -> CreateCollection -> Bool
== :: CreateCollection -> CreateCollection -> Bool
$c== :: CreateCollection -> CreateCollection -> Bool
Prelude.Eq, ReadPrec [CreateCollection]
ReadPrec CreateCollection
Int -> ReadS CreateCollection
ReadS [CreateCollection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCollection]
$creadListPrec :: ReadPrec [CreateCollection]
readPrec :: ReadPrec CreateCollection
$creadPrec :: ReadPrec CreateCollection
readList :: ReadS [CreateCollection]
$creadList :: ReadS [CreateCollection]
readsPrec :: Int -> ReadS CreateCollection
$creadsPrec :: Int -> ReadS CreateCollection
Prelude.Read, Int -> CreateCollection -> ShowS
[CreateCollection] -> ShowS
CreateCollection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCollection] -> ShowS
$cshowList :: [CreateCollection] -> ShowS
show :: CreateCollection -> String
$cshow :: CreateCollection -> String
showsPrec :: Int -> CreateCollection -> ShowS
$cshowsPrec :: Int -> CreateCollection -> ShowS
Prelude.Show, forall x. Rep CreateCollection x -> CreateCollection
forall x. CreateCollection -> Rep CreateCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCollection x -> CreateCollection
$cfrom :: forall x. CreateCollection -> Rep CreateCollection x
Prelude.Generic)

-- |
-- Create a value of 'CreateCollection' 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', 'createCollection_tags' - A set of tags (key-value pairs) that you want to attach to the
-- collection.
--
-- 'collectionId', 'createCollection_collectionId' - ID for the collection that you are creating.
newCreateCollection ::
  -- | 'collectionId'
  Prelude.Text ->
  CreateCollection
newCreateCollection :: Text -> CreateCollection
newCreateCollection Text
pCollectionId_ =
  CreateCollection'
    { $sel:tags:CreateCollection' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:collectionId:CreateCollection' :: Text
collectionId = Text
pCollectionId_
    }

-- | A set of tags (key-value pairs) that you want to attach to the
-- collection.
createCollection_tags :: Lens.Lens' CreateCollection (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createCollection_tags :: Lens' CreateCollection (Maybe (HashMap Text Text))
createCollection_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCollection' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateCollection' :: CreateCollection -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateCollection
s@CreateCollection' {} Maybe (HashMap Text Text)
a -> CreateCollection
s {$sel:tags:CreateCollection' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateCollection) 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

-- | ID for the collection that you are creating.
createCollection_collectionId :: Lens.Lens' CreateCollection Prelude.Text
createCollection_collectionId :: Lens' CreateCollection Text
createCollection_collectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCollection' {Text
collectionId :: Text
$sel:collectionId:CreateCollection' :: CreateCollection -> Text
collectionId} -> Text
collectionId) (\s :: CreateCollection
s@CreateCollection' {} Text
a -> CreateCollection
s {$sel:collectionId:CreateCollection' :: Text
collectionId = Text
a} :: CreateCollection)

instance Core.AWSRequest CreateCollection where
  type
    AWSResponse CreateCollection =
      CreateCollectionResponse
  request :: (Service -> Service)
-> CreateCollection -> Request CreateCollection
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 CreateCollection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCollection)))
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 Text
-> Maybe Text -> Maybe Natural -> Int -> CreateCollectionResponse
CreateCollectionResponse'
            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
"CollectionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FaceModelVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StatusCode")
            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 CreateCollection where
  hashWithSalt :: Int -> CreateCollection -> Int
hashWithSalt Int
_salt CreateCollection' {Maybe (HashMap Text Text)
Text
collectionId :: Text
tags :: Maybe (HashMap Text Text)
$sel:collectionId:CreateCollection' :: CreateCollection -> Text
$sel:tags:CreateCollection' :: CreateCollection -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionId

instance Prelude.NFData CreateCollection where
  rnf :: CreateCollection -> ()
rnf CreateCollection' {Maybe (HashMap Text Text)
Text
collectionId :: Text
tags :: Maybe (HashMap Text Text)
$sel:collectionId:CreateCollection' :: CreateCollection -> Text
$sel:tags:CreateCollection' :: CreateCollection -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
collectionId

instance Data.ToHeaders CreateCollection where
  toHeaders :: CreateCollection -> 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
"RekognitionService.CreateCollection" ::
                          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 CreateCollection where
  toJSON :: CreateCollection -> Value
toJSON CreateCollection' {Maybe (HashMap Text Text)
Text
collectionId :: Text
tags :: Maybe (HashMap Text Text)
$sel:collectionId:CreateCollection' :: CreateCollection -> Text
$sel:tags:CreateCollection' :: CreateCollection -> Maybe (HashMap Text Text)
..} =
    [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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"CollectionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
collectionId)
          ]
      )

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

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

-- | /See:/ 'newCreateCollectionResponse' smart constructor.
data CreateCollectionResponse = CreateCollectionResponse'
  { -- | Amazon Resource Name (ARN) of the collection. You can use this to manage
    -- permissions on your resources.
    CreateCollectionResponse -> Maybe Text
collectionArn :: Prelude.Maybe Prelude.Text,
    -- | Version number of the face detection model associated with the
    -- collection you are creating.
    CreateCollectionResponse -> Maybe Text
faceModelVersion :: Prelude.Maybe Prelude.Text,
    -- | HTTP status code indicating the result of the operation.
    CreateCollectionResponse -> Maybe Natural
statusCode :: Prelude.Maybe Prelude.Natural,
    -- | The response's http status code.
    CreateCollectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCollectionResponse -> CreateCollectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCollectionResponse -> CreateCollectionResponse -> Bool
$c/= :: CreateCollectionResponse -> CreateCollectionResponse -> Bool
== :: CreateCollectionResponse -> CreateCollectionResponse -> Bool
$c== :: CreateCollectionResponse -> CreateCollectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateCollectionResponse]
ReadPrec CreateCollectionResponse
Int -> ReadS CreateCollectionResponse
ReadS [CreateCollectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCollectionResponse]
$creadListPrec :: ReadPrec [CreateCollectionResponse]
readPrec :: ReadPrec CreateCollectionResponse
$creadPrec :: ReadPrec CreateCollectionResponse
readList :: ReadS [CreateCollectionResponse]
$creadList :: ReadS [CreateCollectionResponse]
readsPrec :: Int -> ReadS CreateCollectionResponse
$creadsPrec :: Int -> ReadS CreateCollectionResponse
Prelude.Read, Int -> CreateCollectionResponse -> ShowS
[CreateCollectionResponse] -> ShowS
CreateCollectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCollectionResponse] -> ShowS
$cshowList :: [CreateCollectionResponse] -> ShowS
show :: CreateCollectionResponse -> String
$cshow :: CreateCollectionResponse -> String
showsPrec :: Int -> CreateCollectionResponse -> ShowS
$cshowsPrec :: Int -> CreateCollectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCollectionResponse x -> CreateCollectionResponse
forall x.
CreateCollectionResponse -> Rep CreateCollectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCollectionResponse x -> CreateCollectionResponse
$cfrom :: forall x.
CreateCollectionResponse -> Rep CreateCollectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCollectionResponse' 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:
--
-- 'collectionArn', 'createCollectionResponse_collectionArn' - Amazon Resource Name (ARN) of the collection. You can use this to manage
-- permissions on your resources.
--
-- 'faceModelVersion', 'createCollectionResponse_faceModelVersion' - Version number of the face detection model associated with the
-- collection you are creating.
--
-- 'statusCode', 'createCollectionResponse_statusCode' - HTTP status code indicating the result of the operation.
--
-- 'httpStatus', 'createCollectionResponse_httpStatus' - The response's http status code.
newCreateCollectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCollectionResponse
newCreateCollectionResponse :: Int -> CreateCollectionResponse
newCreateCollectionResponse Int
pHttpStatus_ =
  CreateCollectionResponse'
    { $sel:collectionArn:CreateCollectionResponse' :: Maybe Text
collectionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:faceModelVersion:CreateCollectionResponse' :: Maybe Text
faceModelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:statusCode:CreateCollectionResponse' :: Maybe Natural
statusCode = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCollectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Amazon Resource Name (ARN) of the collection. You can use this to manage
-- permissions on your resources.
createCollectionResponse_collectionArn :: Lens.Lens' CreateCollectionResponse (Prelude.Maybe Prelude.Text)
createCollectionResponse_collectionArn :: Lens' CreateCollectionResponse (Maybe Text)
createCollectionResponse_collectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCollectionResponse' {Maybe Text
collectionArn :: Maybe Text
$sel:collectionArn:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Text
collectionArn} -> Maybe Text
collectionArn) (\s :: CreateCollectionResponse
s@CreateCollectionResponse' {} Maybe Text
a -> CreateCollectionResponse
s {$sel:collectionArn:CreateCollectionResponse' :: Maybe Text
collectionArn = Maybe Text
a} :: CreateCollectionResponse)

-- | Version number of the face detection model associated with the
-- collection you are creating.
createCollectionResponse_faceModelVersion :: Lens.Lens' CreateCollectionResponse (Prelude.Maybe Prelude.Text)
createCollectionResponse_faceModelVersion :: Lens' CreateCollectionResponse (Maybe Text)
createCollectionResponse_faceModelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCollectionResponse' {Maybe Text
faceModelVersion :: Maybe Text
$sel:faceModelVersion:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Text
faceModelVersion} -> Maybe Text
faceModelVersion) (\s :: CreateCollectionResponse
s@CreateCollectionResponse' {} Maybe Text
a -> CreateCollectionResponse
s {$sel:faceModelVersion:CreateCollectionResponse' :: Maybe Text
faceModelVersion = Maybe Text
a} :: CreateCollectionResponse)

-- | HTTP status code indicating the result of the operation.
createCollectionResponse_statusCode :: Lens.Lens' CreateCollectionResponse (Prelude.Maybe Prelude.Natural)
createCollectionResponse_statusCode :: Lens' CreateCollectionResponse (Maybe Natural)
createCollectionResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCollectionResponse' {Maybe Natural
statusCode :: Maybe Natural
$sel:statusCode:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Natural
statusCode} -> Maybe Natural
statusCode) (\s :: CreateCollectionResponse
s@CreateCollectionResponse' {} Maybe Natural
a -> CreateCollectionResponse
s {$sel:statusCode:CreateCollectionResponse' :: Maybe Natural
statusCode = Maybe Natural
a} :: CreateCollectionResponse)

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

instance Prelude.NFData CreateCollectionResponse where
  rnf :: CreateCollectionResponse -> ()
rnf CreateCollectionResponse' {Int
Maybe Natural
Maybe Text
httpStatus :: Int
statusCode :: Maybe Natural
faceModelVersion :: Maybe Text
collectionArn :: Maybe Text
$sel:httpStatus:CreateCollectionResponse' :: CreateCollectionResponse -> Int
$sel:statusCode:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Natural
$sel:faceModelVersion:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Text
$sel:collectionArn:CreateCollectionResponse' :: CreateCollectionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
collectionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
faceModelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
statusCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus