{-# 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.CognitoIdentity.DeleteIdentities
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes identities from an identity pool. You can specify a list of 1-60
-- identities that you want to delete.
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.DeleteIdentities
  ( -- * Creating a Request
    DeleteIdentities (..),
    newDeleteIdentities,

    -- * Request Lenses
    deleteIdentities_identityIdsToDelete,

    -- * Destructuring the Response
    DeleteIdentitiesResponse (..),
    newDeleteIdentitiesResponse,

    -- * Response Lenses
    deleteIdentitiesResponse_unprocessedIdentityIds,
    deleteIdentitiesResponse_httpStatus,
  )
where

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

-- | Input to the @DeleteIdentities@ action.
--
-- /See:/ 'newDeleteIdentities' smart constructor.
data DeleteIdentities = DeleteIdentities'
  { -- | A list of 1-60 identities that you want to delete.
    DeleteIdentities -> NonEmpty Text
identityIdsToDelete :: Prelude.NonEmpty Prelude.Text
  }
  deriving (DeleteIdentities -> DeleteIdentities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteIdentities -> DeleteIdentities -> Bool
$c/= :: DeleteIdentities -> DeleteIdentities -> Bool
== :: DeleteIdentities -> DeleteIdentities -> Bool
$c== :: DeleteIdentities -> DeleteIdentities -> Bool
Prelude.Eq, ReadPrec [DeleteIdentities]
ReadPrec DeleteIdentities
Int -> ReadS DeleteIdentities
ReadS [DeleteIdentities]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteIdentities]
$creadListPrec :: ReadPrec [DeleteIdentities]
readPrec :: ReadPrec DeleteIdentities
$creadPrec :: ReadPrec DeleteIdentities
readList :: ReadS [DeleteIdentities]
$creadList :: ReadS [DeleteIdentities]
readsPrec :: Int -> ReadS DeleteIdentities
$creadsPrec :: Int -> ReadS DeleteIdentities
Prelude.Read, Int -> DeleteIdentities -> ShowS
[DeleteIdentities] -> ShowS
DeleteIdentities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteIdentities] -> ShowS
$cshowList :: [DeleteIdentities] -> ShowS
show :: DeleteIdentities -> String
$cshow :: DeleteIdentities -> String
showsPrec :: Int -> DeleteIdentities -> ShowS
$cshowsPrec :: Int -> DeleteIdentities -> ShowS
Prelude.Show, forall x. Rep DeleteIdentities x -> DeleteIdentities
forall x. DeleteIdentities -> Rep DeleteIdentities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteIdentities x -> DeleteIdentities
$cfrom :: forall x. DeleteIdentities -> Rep DeleteIdentities x
Prelude.Generic)

-- |
-- Create a value of 'DeleteIdentities' 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:
--
-- 'identityIdsToDelete', 'deleteIdentities_identityIdsToDelete' - A list of 1-60 identities that you want to delete.
newDeleteIdentities ::
  -- | 'identityIdsToDelete'
  Prelude.NonEmpty Prelude.Text ->
  DeleteIdentities
newDeleteIdentities :: NonEmpty Text -> DeleteIdentities
newDeleteIdentities NonEmpty Text
pIdentityIdsToDelete_ =
  DeleteIdentities'
    { $sel:identityIdsToDelete:DeleteIdentities' :: NonEmpty Text
identityIdsToDelete =
        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 Text
pIdentityIdsToDelete_
    }

-- | A list of 1-60 identities that you want to delete.
deleteIdentities_identityIdsToDelete :: Lens.Lens' DeleteIdentities (Prelude.NonEmpty Prelude.Text)
deleteIdentities_identityIdsToDelete :: Lens' DeleteIdentities (NonEmpty Text)
deleteIdentities_identityIdsToDelete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIdentities' {NonEmpty Text
identityIdsToDelete :: NonEmpty Text
$sel:identityIdsToDelete:DeleteIdentities' :: DeleteIdentities -> NonEmpty Text
identityIdsToDelete} -> NonEmpty Text
identityIdsToDelete) (\s :: DeleteIdentities
s@DeleteIdentities' {} NonEmpty Text
a -> DeleteIdentities
s {$sel:identityIdsToDelete:DeleteIdentities' :: NonEmpty Text
identityIdsToDelete = NonEmpty Text
a} :: DeleteIdentities) 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 DeleteIdentities where
  type
    AWSResponse DeleteIdentities =
      DeleteIdentitiesResponse
  request :: (Service -> Service)
-> DeleteIdentities -> Request DeleteIdentities
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 DeleteIdentities
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteIdentities)))
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 [UnprocessedIdentityId] -> Int -> DeleteIdentitiesResponse
DeleteIdentitiesResponse'
            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
"UnprocessedIdentityIds"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 DeleteIdentities where
  hashWithSalt :: Int -> DeleteIdentities -> Int
hashWithSalt Int
_salt DeleteIdentities' {NonEmpty Text
identityIdsToDelete :: NonEmpty Text
$sel:identityIdsToDelete:DeleteIdentities' :: DeleteIdentities -> NonEmpty Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
identityIdsToDelete

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

instance Data.ToHeaders DeleteIdentities where
  toHeaders :: DeleteIdentities -> 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
"AWSCognitoIdentityService.DeleteIdentities" ::
                          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 DeleteIdentities where
  toJSON :: DeleteIdentities -> Value
toJSON DeleteIdentities' {NonEmpty Text
identityIdsToDelete :: NonEmpty Text
$sel:identityIdsToDelete:DeleteIdentities' :: DeleteIdentities -> NonEmpty Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityIdsToDelete" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
identityIdsToDelete)
          ]
      )

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

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

-- | Returned in response to a successful @DeleteIdentities@ operation.
--
-- /See:/ 'newDeleteIdentitiesResponse' smart constructor.
data DeleteIdentitiesResponse = DeleteIdentitiesResponse'
  { -- | An array of UnprocessedIdentityId objects, each of which contains an
    -- ErrorCode and IdentityId.
    DeleteIdentitiesResponse -> Maybe [UnprocessedIdentityId]
unprocessedIdentityIds :: Prelude.Maybe [UnprocessedIdentityId],
    -- | The response's http status code.
    DeleteIdentitiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteIdentitiesResponse -> DeleteIdentitiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteIdentitiesResponse -> DeleteIdentitiesResponse -> Bool
$c/= :: DeleteIdentitiesResponse -> DeleteIdentitiesResponse -> Bool
== :: DeleteIdentitiesResponse -> DeleteIdentitiesResponse -> Bool
$c== :: DeleteIdentitiesResponse -> DeleteIdentitiesResponse -> Bool
Prelude.Eq, ReadPrec [DeleteIdentitiesResponse]
ReadPrec DeleteIdentitiesResponse
Int -> ReadS DeleteIdentitiesResponse
ReadS [DeleteIdentitiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteIdentitiesResponse]
$creadListPrec :: ReadPrec [DeleteIdentitiesResponse]
readPrec :: ReadPrec DeleteIdentitiesResponse
$creadPrec :: ReadPrec DeleteIdentitiesResponse
readList :: ReadS [DeleteIdentitiesResponse]
$creadList :: ReadS [DeleteIdentitiesResponse]
readsPrec :: Int -> ReadS DeleteIdentitiesResponse
$creadsPrec :: Int -> ReadS DeleteIdentitiesResponse
Prelude.Read, Int -> DeleteIdentitiesResponse -> ShowS
[DeleteIdentitiesResponse] -> ShowS
DeleteIdentitiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteIdentitiesResponse] -> ShowS
$cshowList :: [DeleteIdentitiesResponse] -> ShowS
show :: DeleteIdentitiesResponse -> String
$cshow :: DeleteIdentitiesResponse -> String
showsPrec :: Int -> DeleteIdentitiesResponse -> ShowS
$cshowsPrec :: Int -> DeleteIdentitiesResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteIdentitiesResponse x -> DeleteIdentitiesResponse
forall x.
DeleteIdentitiesResponse -> Rep DeleteIdentitiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteIdentitiesResponse x -> DeleteIdentitiesResponse
$cfrom :: forall x.
DeleteIdentitiesResponse -> Rep DeleteIdentitiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteIdentitiesResponse' 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:
--
-- 'unprocessedIdentityIds', 'deleteIdentitiesResponse_unprocessedIdentityIds' - An array of UnprocessedIdentityId objects, each of which contains an
-- ErrorCode and IdentityId.
--
-- 'httpStatus', 'deleteIdentitiesResponse_httpStatus' - The response's http status code.
newDeleteIdentitiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteIdentitiesResponse
newDeleteIdentitiesResponse :: Int -> DeleteIdentitiesResponse
newDeleteIdentitiesResponse Int
pHttpStatus_ =
  DeleteIdentitiesResponse'
    { $sel:unprocessedIdentityIds:DeleteIdentitiesResponse' :: Maybe [UnprocessedIdentityId]
unprocessedIdentityIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteIdentitiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of UnprocessedIdentityId objects, each of which contains an
-- ErrorCode and IdentityId.
deleteIdentitiesResponse_unprocessedIdentityIds :: Lens.Lens' DeleteIdentitiesResponse (Prelude.Maybe [UnprocessedIdentityId])
deleteIdentitiesResponse_unprocessedIdentityIds :: Lens' DeleteIdentitiesResponse (Maybe [UnprocessedIdentityId])
deleteIdentitiesResponse_unprocessedIdentityIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIdentitiesResponse' {Maybe [UnprocessedIdentityId]
unprocessedIdentityIds :: Maybe [UnprocessedIdentityId]
$sel:unprocessedIdentityIds:DeleteIdentitiesResponse' :: DeleteIdentitiesResponse -> Maybe [UnprocessedIdentityId]
unprocessedIdentityIds} -> Maybe [UnprocessedIdentityId]
unprocessedIdentityIds) (\s :: DeleteIdentitiesResponse
s@DeleteIdentitiesResponse' {} Maybe [UnprocessedIdentityId]
a -> DeleteIdentitiesResponse
s {$sel:unprocessedIdentityIds:DeleteIdentitiesResponse' :: Maybe [UnprocessedIdentityId]
unprocessedIdentityIds = Maybe [UnprocessedIdentityId]
a} :: DeleteIdentitiesResponse) 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 response's http status code.
deleteIdentitiesResponse_httpStatus :: Lens.Lens' DeleteIdentitiesResponse Prelude.Int
deleteIdentitiesResponse_httpStatus :: Lens' DeleteIdentitiesResponse Int
deleteIdentitiesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIdentitiesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteIdentitiesResponse' :: DeleteIdentitiesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteIdentitiesResponse
s@DeleteIdentitiesResponse' {} Int
a -> DeleteIdentitiesResponse
s {$sel:httpStatus:DeleteIdentitiesResponse' :: Int
httpStatus = Int
a} :: DeleteIdentitiesResponse)

instance Prelude.NFData DeleteIdentitiesResponse where
  rnf :: DeleteIdentitiesResponse -> ()
rnf DeleteIdentitiesResponse' {Int
Maybe [UnprocessedIdentityId]
httpStatus :: Int
unprocessedIdentityIds :: Maybe [UnprocessedIdentityId]
$sel:httpStatus:DeleteIdentitiesResponse' :: DeleteIdentitiesResponse -> Int
$sel:unprocessedIdentityIds:DeleteIdentitiesResponse' :: DeleteIdentitiesResponse -> Maybe [UnprocessedIdentityId]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnprocessedIdentityId]
unprocessedIdentityIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus