{-# 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.DescribeCollection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified collection. You can use @DescribeCollection@ to
-- get information, such as the number of faces indexed into a collection
-- and the version of the model used by the collection for face detection.
--
-- For more information, see Describing a Collection in the Amazon
-- Rekognition Developer Guide.
module Amazonka.Rekognition.DescribeCollection
  ( -- * Creating a Request
    DescribeCollection (..),
    newDescribeCollection,

    -- * Request Lenses
    describeCollection_collectionId,

    -- * Destructuring the Response
    DescribeCollectionResponse (..),
    newDescribeCollectionResponse,

    -- * Response Lenses
    describeCollectionResponse_collectionARN,
    describeCollectionResponse_creationTimestamp,
    describeCollectionResponse_faceCount,
    describeCollectionResponse_faceModelVersion,
    describeCollectionResponse_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:/ 'newDescribeCollection' smart constructor.
data DescribeCollection = DescribeCollection'
  { -- | The ID of the collection to describe.
    DescribeCollection -> Text
collectionId :: Prelude.Text
  }
  deriving (DescribeCollection -> DescribeCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCollection -> DescribeCollection -> Bool
$c/= :: DescribeCollection -> DescribeCollection -> Bool
== :: DescribeCollection -> DescribeCollection -> Bool
$c== :: DescribeCollection -> DescribeCollection -> Bool
Prelude.Eq, ReadPrec [DescribeCollection]
ReadPrec DescribeCollection
Int -> ReadS DescribeCollection
ReadS [DescribeCollection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCollection]
$creadListPrec :: ReadPrec [DescribeCollection]
readPrec :: ReadPrec DescribeCollection
$creadPrec :: ReadPrec DescribeCollection
readList :: ReadS [DescribeCollection]
$creadList :: ReadS [DescribeCollection]
readsPrec :: Int -> ReadS DescribeCollection
$creadsPrec :: Int -> ReadS DescribeCollection
Prelude.Read, Int -> DescribeCollection -> ShowS
[DescribeCollection] -> ShowS
DescribeCollection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCollection] -> ShowS
$cshowList :: [DescribeCollection] -> ShowS
show :: DescribeCollection -> String
$cshow :: DescribeCollection -> String
showsPrec :: Int -> DescribeCollection -> ShowS
$cshowsPrec :: Int -> DescribeCollection -> ShowS
Prelude.Show, forall x. Rep DescribeCollection x -> DescribeCollection
forall x. DescribeCollection -> Rep DescribeCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCollection x -> DescribeCollection
$cfrom :: forall x. DescribeCollection -> Rep DescribeCollection x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCollection' 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:
--
-- 'collectionId', 'describeCollection_collectionId' - The ID of the collection to describe.
newDescribeCollection ::
  -- | 'collectionId'
  Prelude.Text ->
  DescribeCollection
newDescribeCollection :: Text -> DescribeCollection
newDescribeCollection Text
pCollectionId_ =
  DescribeCollection' {$sel:collectionId:DescribeCollection' :: Text
collectionId = Text
pCollectionId_}

-- | The ID of the collection to describe.
describeCollection_collectionId :: Lens.Lens' DescribeCollection Prelude.Text
describeCollection_collectionId :: Lens' DescribeCollection Text
describeCollection_collectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCollection' {Text
collectionId :: Text
$sel:collectionId:DescribeCollection' :: DescribeCollection -> Text
collectionId} -> Text
collectionId) (\s :: DescribeCollection
s@DescribeCollection' {} Text
a -> DescribeCollection
s {$sel:collectionId:DescribeCollection' :: Text
collectionId = Text
a} :: DescribeCollection)

instance Core.AWSRequest DescribeCollection where
  type
    AWSResponse DescribeCollection =
      DescribeCollectionResponse
  request :: (Service -> Service)
-> DescribeCollection -> Request DescribeCollection
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 DescribeCollection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeCollection)))
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 POSIX
-> Maybe Natural
-> Maybe Text
-> Int
-> DescribeCollectionResponse
DescribeCollectionResponse'
            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
"CreationTimestamp")
            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
"FaceCount")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribeCollection where
  hashWithSalt :: Int -> DescribeCollection -> Int
hashWithSalt Int
_salt DescribeCollection' {Text
collectionId :: Text
$sel:collectionId:DescribeCollection' :: DescribeCollection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionId

instance Prelude.NFData DescribeCollection where
  rnf :: DescribeCollection -> ()
rnf DescribeCollection' {Text
collectionId :: Text
$sel:collectionId:DescribeCollection' :: DescribeCollection -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
collectionId

instance Data.ToHeaders DescribeCollection where
  toHeaders :: DescribeCollection -> 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.DescribeCollection" ::
                          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 DescribeCollection where
  toJSON :: DescribeCollection -> Value
toJSON DescribeCollection' {Text
collectionId :: Text
$sel:collectionId:DescribeCollection' :: DescribeCollection -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 DescribeCollection where
  toPath :: DescribeCollection -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeCollectionResponse' smart constructor.
data DescribeCollectionResponse = DescribeCollectionResponse'
  { -- | The Amazon Resource Name (ARN) of the collection.
    DescribeCollectionResponse -> Maybe Text
collectionARN :: Prelude.Maybe Prelude.Text,
    -- | The number of milliseconds since the Unix epoch time until the creation
    -- of the collection. The Unix epoch time is 00:00:00 Coordinated Universal
    -- Time (UTC), Thursday, 1 January 1970.
    DescribeCollectionResponse -> Maybe POSIX
creationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The number of faces that are indexed into the collection. To index faces
    -- into a collection, use IndexFaces.
    DescribeCollectionResponse -> Maybe Natural
faceCount :: Prelude.Maybe Prelude.Natural,
    -- | The version of the face model that\'s used by the collection for face
    -- detection.
    --
    -- For more information, see Model versioning in the Amazon Rekognition
    -- Developer Guide.
    DescribeCollectionResponse -> Maybe Text
faceModelVersion :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeCollectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeCollectionResponse -> DescribeCollectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCollectionResponse -> DescribeCollectionResponse -> Bool
$c/= :: DescribeCollectionResponse -> DescribeCollectionResponse -> Bool
== :: DescribeCollectionResponse -> DescribeCollectionResponse -> Bool
$c== :: DescribeCollectionResponse -> DescribeCollectionResponse -> Bool
Prelude.Eq, ReadPrec [DescribeCollectionResponse]
ReadPrec DescribeCollectionResponse
Int -> ReadS DescribeCollectionResponse
ReadS [DescribeCollectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCollectionResponse]
$creadListPrec :: ReadPrec [DescribeCollectionResponse]
readPrec :: ReadPrec DescribeCollectionResponse
$creadPrec :: ReadPrec DescribeCollectionResponse
readList :: ReadS [DescribeCollectionResponse]
$creadList :: ReadS [DescribeCollectionResponse]
readsPrec :: Int -> ReadS DescribeCollectionResponse
$creadsPrec :: Int -> ReadS DescribeCollectionResponse
Prelude.Read, Int -> DescribeCollectionResponse -> ShowS
[DescribeCollectionResponse] -> ShowS
DescribeCollectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCollectionResponse] -> ShowS
$cshowList :: [DescribeCollectionResponse] -> ShowS
show :: DescribeCollectionResponse -> String
$cshow :: DescribeCollectionResponse -> String
showsPrec :: Int -> DescribeCollectionResponse -> ShowS
$cshowsPrec :: Int -> DescribeCollectionResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeCollectionResponse x -> DescribeCollectionResponse
forall x.
DescribeCollectionResponse -> Rep DescribeCollectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeCollectionResponse x -> DescribeCollectionResponse
$cfrom :: forall x.
DescribeCollectionResponse -> Rep DescribeCollectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCollectionResponse' 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', 'describeCollectionResponse_collectionARN' - The Amazon Resource Name (ARN) of the collection.
--
-- 'creationTimestamp', 'describeCollectionResponse_creationTimestamp' - The number of milliseconds since the Unix epoch time until the creation
-- of the collection. The Unix epoch time is 00:00:00 Coordinated Universal
-- Time (UTC), Thursday, 1 January 1970.
--
-- 'faceCount', 'describeCollectionResponse_faceCount' - The number of faces that are indexed into the collection. To index faces
-- into a collection, use IndexFaces.
--
-- 'faceModelVersion', 'describeCollectionResponse_faceModelVersion' - The version of the face model that\'s used by the collection for face
-- detection.
--
-- For more information, see Model versioning in the Amazon Rekognition
-- Developer Guide.
--
-- 'httpStatus', 'describeCollectionResponse_httpStatus' - The response's http status code.
newDescribeCollectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeCollectionResponse
newDescribeCollectionResponse :: Int -> DescribeCollectionResponse
newDescribeCollectionResponse Int
pHttpStatus_ =
  DescribeCollectionResponse'
    { $sel:collectionARN:DescribeCollectionResponse' :: Maybe Text
collectionARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimestamp:DescribeCollectionResponse' :: Maybe POSIX
creationTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:faceCount:DescribeCollectionResponse' :: Maybe Natural
faceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:faceModelVersion:DescribeCollectionResponse' :: Maybe Text
faceModelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeCollectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the collection.
describeCollectionResponse_collectionARN :: Lens.Lens' DescribeCollectionResponse (Prelude.Maybe Prelude.Text)
describeCollectionResponse_collectionARN :: Lens' DescribeCollectionResponse (Maybe Text)
describeCollectionResponse_collectionARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCollectionResponse' {Maybe Text
collectionARN :: Maybe Text
$sel:collectionARN:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe Text
collectionARN} -> Maybe Text
collectionARN) (\s :: DescribeCollectionResponse
s@DescribeCollectionResponse' {} Maybe Text
a -> DescribeCollectionResponse
s {$sel:collectionARN:DescribeCollectionResponse' :: Maybe Text
collectionARN = Maybe Text
a} :: DescribeCollectionResponse)

-- | The number of milliseconds since the Unix epoch time until the creation
-- of the collection. The Unix epoch time is 00:00:00 Coordinated Universal
-- Time (UTC), Thursday, 1 January 1970.
describeCollectionResponse_creationTimestamp :: Lens.Lens' DescribeCollectionResponse (Prelude.Maybe Prelude.UTCTime)
describeCollectionResponse_creationTimestamp :: Lens' DescribeCollectionResponse (Maybe UTCTime)
describeCollectionResponse_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCollectionResponse' {Maybe POSIX
creationTimestamp :: Maybe POSIX
$sel:creationTimestamp:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe POSIX
creationTimestamp} -> Maybe POSIX
creationTimestamp) (\s :: DescribeCollectionResponse
s@DescribeCollectionResponse' {} Maybe POSIX
a -> DescribeCollectionResponse
s {$sel:creationTimestamp:DescribeCollectionResponse' :: Maybe POSIX
creationTimestamp = Maybe POSIX
a} :: DescribeCollectionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The number of faces that are indexed into the collection. To index faces
-- into a collection, use IndexFaces.
describeCollectionResponse_faceCount :: Lens.Lens' DescribeCollectionResponse (Prelude.Maybe Prelude.Natural)
describeCollectionResponse_faceCount :: Lens' DescribeCollectionResponse (Maybe Natural)
describeCollectionResponse_faceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCollectionResponse' {Maybe Natural
faceCount :: Maybe Natural
$sel:faceCount:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe Natural
faceCount} -> Maybe Natural
faceCount) (\s :: DescribeCollectionResponse
s@DescribeCollectionResponse' {} Maybe Natural
a -> DescribeCollectionResponse
s {$sel:faceCount:DescribeCollectionResponse' :: Maybe Natural
faceCount = Maybe Natural
a} :: DescribeCollectionResponse)

-- | The version of the face model that\'s used by the collection for face
-- detection.
--
-- For more information, see Model versioning in the Amazon Rekognition
-- Developer Guide.
describeCollectionResponse_faceModelVersion :: Lens.Lens' DescribeCollectionResponse (Prelude.Maybe Prelude.Text)
describeCollectionResponse_faceModelVersion :: Lens' DescribeCollectionResponse (Maybe Text)
describeCollectionResponse_faceModelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCollectionResponse' {Maybe Text
faceModelVersion :: Maybe Text
$sel:faceModelVersion:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe Text
faceModelVersion} -> Maybe Text
faceModelVersion) (\s :: DescribeCollectionResponse
s@DescribeCollectionResponse' {} Maybe Text
a -> DescribeCollectionResponse
s {$sel:faceModelVersion:DescribeCollectionResponse' :: Maybe Text
faceModelVersion = Maybe Text
a} :: DescribeCollectionResponse)

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

instance Prelude.NFData DescribeCollectionResponse where
  rnf :: DescribeCollectionResponse -> ()
rnf DescribeCollectionResponse' {Int
Maybe Natural
Maybe Text
Maybe POSIX
httpStatus :: Int
faceModelVersion :: Maybe Text
faceCount :: Maybe Natural
creationTimestamp :: Maybe POSIX
collectionARN :: Maybe Text
$sel:httpStatus:DescribeCollectionResponse' :: DescribeCollectionResponse -> Int
$sel:faceModelVersion:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe Text
$sel:faceCount:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe Natural
$sel:creationTimestamp:DescribeCollectionResponse' :: DescribeCollectionResponse -> Maybe POSIX
$sel:collectionARN:DescribeCollectionResponse' :: DescribeCollectionResponse -> 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 POSIX
creationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
faceCount
      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 Int
httpStatus