{-# 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.ConnectCases.BatchPutFieldOptions
-- 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 and updates a set of field options for a single select field in
-- a Cases domain.
module Amazonka.ConnectCases.BatchPutFieldOptions
  ( -- * Creating a Request
    BatchPutFieldOptions (..),
    newBatchPutFieldOptions,

    -- * Request Lenses
    batchPutFieldOptions_domainId,
    batchPutFieldOptions_fieldId,
    batchPutFieldOptions_options,

    -- * Destructuring the Response
    BatchPutFieldOptionsResponse (..),
    newBatchPutFieldOptionsResponse,

    -- * Response Lenses
    batchPutFieldOptionsResponse_errors,
    batchPutFieldOptionsResponse_httpStatus,
  )
where

import Amazonka.ConnectCases.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

-- | /See:/ 'newBatchPutFieldOptions' smart constructor.
data BatchPutFieldOptions = BatchPutFieldOptions'
  { -- | The unique identifier of the Cases domain.
    BatchPutFieldOptions -> Text
domainId :: Prelude.Text,
    -- | The unique identifier of a field.
    BatchPutFieldOptions -> Text
fieldId :: Prelude.Text,
    -- | A list of @FieldOption@ objects.
    BatchPutFieldOptions -> [FieldOption]
options :: [FieldOption]
  }
  deriving (BatchPutFieldOptions -> BatchPutFieldOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutFieldOptions -> BatchPutFieldOptions -> Bool
$c/= :: BatchPutFieldOptions -> BatchPutFieldOptions -> Bool
== :: BatchPutFieldOptions -> BatchPutFieldOptions -> Bool
$c== :: BatchPutFieldOptions -> BatchPutFieldOptions -> Bool
Prelude.Eq, ReadPrec [BatchPutFieldOptions]
ReadPrec BatchPutFieldOptions
Int -> ReadS BatchPutFieldOptions
ReadS [BatchPutFieldOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutFieldOptions]
$creadListPrec :: ReadPrec [BatchPutFieldOptions]
readPrec :: ReadPrec BatchPutFieldOptions
$creadPrec :: ReadPrec BatchPutFieldOptions
readList :: ReadS [BatchPutFieldOptions]
$creadList :: ReadS [BatchPutFieldOptions]
readsPrec :: Int -> ReadS BatchPutFieldOptions
$creadsPrec :: Int -> ReadS BatchPutFieldOptions
Prelude.Read, Int -> BatchPutFieldOptions -> ShowS
[BatchPutFieldOptions] -> ShowS
BatchPutFieldOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutFieldOptions] -> ShowS
$cshowList :: [BatchPutFieldOptions] -> ShowS
show :: BatchPutFieldOptions -> String
$cshow :: BatchPutFieldOptions -> String
showsPrec :: Int -> BatchPutFieldOptions -> ShowS
$cshowsPrec :: Int -> BatchPutFieldOptions -> ShowS
Prelude.Show, forall x. Rep BatchPutFieldOptions x -> BatchPutFieldOptions
forall x. BatchPutFieldOptions -> Rep BatchPutFieldOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchPutFieldOptions x -> BatchPutFieldOptions
$cfrom :: forall x. BatchPutFieldOptions -> Rep BatchPutFieldOptions x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutFieldOptions' 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:
--
-- 'domainId', 'batchPutFieldOptions_domainId' - The unique identifier of the Cases domain.
--
-- 'fieldId', 'batchPutFieldOptions_fieldId' - The unique identifier of a field.
--
-- 'options', 'batchPutFieldOptions_options' - A list of @FieldOption@ objects.
newBatchPutFieldOptions ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'fieldId'
  Prelude.Text ->
  BatchPutFieldOptions
newBatchPutFieldOptions :: Text -> Text -> BatchPutFieldOptions
newBatchPutFieldOptions Text
pDomainId_ Text
pFieldId_ =
  BatchPutFieldOptions'
    { $sel:domainId:BatchPutFieldOptions' :: Text
domainId = Text
pDomainId_,
      $sel:fieldId:BatchPutFieldOptions' :: Text
fieldId = Text
pFieldId_,
      $sel:options:BatchPutFieldOptions' :: [FieldOption]
options = forall a. Monoid a => a
Prelude.mempty
    }

-- | The unique identifier of the Cases domain.
batchPutFieldOptions_domainId :: Lens.Lens' BatchPutFieldOptions Prelude.Text
batchPutFieldOptions_domainId :: Lens' BatchPutFieldOptions Text
batchPutFieldOptions_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutFieldOptions' {Text
domainId :: Text
$sel:domainId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
domainId} -> Text
domainId) (\s :: BatchPutFieldOptions
s@BatchPutFieldOptions' {} Text
a -> BatchPutFieldOptions
s {$sel:domainId:BatchPutFieldOptions' :: Text
domainId = Text
a} :: BatchPutFieldOptions)

-- | The unique identifier of a field.
batchPutFieldOptions_fieldId :: Lens.Lens' BatchPutFieldOptions Prelude.Text
batchPutFieldOptions_fieldId :: Lens' BatchPutFieldOptions Text
batchPutFieldOptions_fieldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutFieldOptions' {Text
fieldId :: Text
$sel:fieldId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
fieldId} -> Text
fieldId) (\s :: BatchPutFieldOptions
s@BatchPutFieldOptions' {} Text
a -> BatchPutFieldOptions
s {$sel:fieldId:BatchPutFieldOptions' :: Text
fieldId = Text
a} :: BatchPutFieldOptions)

-- | A list of @FieldOption@ objects.
batchPutFieldOptions_options :: Lens.Lens' BatchPutFieldOptions [FieldOption]
batchPutFieldOptions_options :: Lens' BatchPutFieldOptions [FieldOption]
batchPutFieldOptions_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutFieldOptions' {[FieldOption]
options :: [FieldOption]
$sel:options:BatchPutFieldOptions' :: BatchPutFieldOptions -> [FieldOption]
options} -> [FieldOption]
options) (\s :: BatchPutFieldOptions
s@BatchPutFieldOptions' {} [FieldOption]
a -> BatchPutFieldOptions
s {$sel:options:BatchPutFieldOptions' :: [FieldOption]
options = [FieldOption]
a} :: BatchPutFieldOptions) 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 BatchPutFieldOptions where
  type
    AWSResponse BatchPutFieldOptions =
      BatchPutFieldOptionsResponse
  request :: (Service -> Service)
-> BatchPutFieldOptions -> Request BatchPutFieldOptions
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchPutFieldOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchPutFieldOptions)))
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 [FieldOptionError] -> Int -> BatchPutFieldOptionsResponse
BatchPutFieldOptionsResponse'
            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
"errors" 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 BatchPutFieldOptions where
  hashWithSalt :: Int -> BatchPutFieldOptions -> Int
hashWithSalt Int
_salt BatchPutFieldOptions' {[FieldOption]
Text
options :: [FieldOption]
fieldId :: Text
domainId :: Text
$sel:options:BatchPutFieldOptions' :: BatchPutFieldOptions -> [FieldOption]
$sel:fieldId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
$sel:domainId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fieldId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [FieldOption]
options

instance Prelude.NFData BatchPutFieldOptions where
  rnf :: BatchPutFieldOptions -> ()
rnf BatchPutFieldOptions' {[FieldOption]
Text
options :: [FieldOption]
fieldId :: Text
domainId :: Text
$sel:options:BatchPutFieldOptions' :: BatchPutFieldOptions -> [FieldOption]
$sel:fieldId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
$sel:domainId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fieldId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [FieldOption]
options

instance Data.ToHeaders BatchPutFieldOptions where
  toHeaders :: BatchPutFieldOptions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON BatchPutFieldOptions where
  toJSON :: BatchPutFieldOptions -> Value
toJSON BatchPutFieldOptions' {[FieldOption]
Text
options :: [FieldOption]
fieldId :: Text
domainId :: Text
$sel:options:BatchPutFieldOptions' :: BatchPutFieldOptions -> [FieldOption]
$sel:fieldId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
$sel:domainId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [FieldOption]
options)]
      )

instance Data.ToPath BatchPutFieldOptions where
  toPath :: BatchPutFieldOptions -> ByteString
toPath BatchPutFieldOptions' {[FieldOption]
Text
options :: [FieldOption]
fieldId :: Text
domainId :: Text
$sel:options:BatchPutFieldOptions' :: BatchPutFieldOptions -> [FieldOption]
$sel:fieldId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
$sel:domainId:BatchPutFieldOptions' :: BatchPutFieldOptions -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId,
        ByteString
"/fields/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
fieldId,
        ByteString
"/options"
      ]

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

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

-- |
-- Create a value of 'BatchPutFieldOptionsResponse' 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:
--
-- 'errors', 'batchPutFieldOptionsResponse_errors' - A list of field errors.
--
-- 'httpStatus', 'batchPutFieldOptionsResponse_httpStatus' - The response's http status code.
newBatchPutFieldOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchPutFieldOptionsResponse
newBatchPutFieldOptionsResponse :: Int -> BatchPutFieldOptionsResponse
newBatchPutFieldOptionsResponse Int
pHttpStatus_ =
  BatchPutFieldOptionsResponse'
    { $sel:errors:BatchPutFieldOptionsResponse' :: Maybe [FieldOptionError]
errors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchPutFieldOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of field errors.
batchPutFieldOptionsResponse_errors :: Lens.Lens' BatchPutFieldOptionsResponse (Prelude.Maybe [FieldOptionError])
batchPutFieldOptionsResponse_errors :: Lens' BatchPutFieldOptionsResponse (Maybe [FieldOptionError])
batchPutFieldOptionsResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutFieldOptionsResponse' {Maybe [FieldOptionError]
errors :: Maybe [FieldOptionError]
$sel:errors:BatchPutFieldOptionsResponse' :: BatchPutFieldOptionsResponse -> Maybe [FieldOptionError]
errors} -> Maybe [FieldOptionError]
errors) (\s :: BatchPutFieldOptionsResponse
s@BatchPutFieldOptionsResponse' {} Maybe [FieldOptionError]
a -> BatchPutFieldOptionsResponse
s {$sel:errors:BatchPutFieldOptionsResponse' :: Maybe [FieldOptionError]
errors = Maybe [FieldOptionError]
a} :: BatchPutFieldOptionsResponse) 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.
batchPutFieldOptionsResponse_httpStatus :: Lens.Lens' BatchPutFieldOptionsResponse Prelude.Int
batchPutFieldOptionsResponse_httpStatus :: Lens' BatchPutFieldOptionsResponse Int
batchPutFieldOptionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutFieldOptionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchPutFieldOptionsResponse' :: BatchPutFieldOptionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchPutFieldOptionsResponse
s@BatchPutFieldOptionsResponse' {} Int
a -> BatchPutFieldOptionsResponse
s {$sel:httpStatus:BatchPutFieldOptionsResponse' :: Int
httpStatus = Int
a} :: BatchPutFieldOptionsResponse)

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