{-# 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.WorkMail.UpdateResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates data for the resource. To have the latest information, it must
-- be preceded by a DescribeResource call. The dataset in the request
-- should be the one expected when performing another @DescribeResource@
-- call.
module Amazonka.WorkMail.UpdateResource
  ( -- * Creating a Request
    UpdateResource (..),
    newUpdateResource,

    -- * Request Lenses
    updateResource_bookingOptions,
    updateResource_name,
    updateResource_organizationId,
    updateResource_resourceId,

    -- * Destructuring the Response
    UpdateResourceResponse (..),
    newUpdateResourceResponse,

    -- * Response Lenses
    updateResourceResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WorkMail.Types

-- | /See:/ 'newUpdateResource' smart constructor.
data UpdateResource = UpdateResource'
  { -- | The resource\'s booking options to be updated.
    UpdateResource -> Maybe BookingOptions
bookingOptions :: Prelude.Maybe BookingOptions,
    -- | The name of the resource to be updated.
    UpdateResource -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The identifier associated with the organization for which the resource
    -- is updated.
    UpdateResource -> Text
organizationId :: Prelude.Text,
    -- | The identifier of the resource to be updated.
    UpdateResource -> Text
resourceId :: Prelude.Text
  }
  deriving (UpdateResource -> UpdateResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateResource -> UpdateResource -> Bool
$c/= :: UpdateResource -> UpdateResource -> Bool
== :: UpdateResource -> UpdateResource -> Bool
$c== :: UpdateResource -> UpdateResource -> Bool
Prelude.Eq, ReadPrec [UpdateResource]
ReadPrec UpdateResource
Int -> ReadS UpdateResource
ReadS [UpdateResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateResource]
$creadListPrec :: ReadPrec [UpdateResource]
readPrec :: ReadPrec UpdateResource
$creadPrec :: ReadPrec UpdateResource
readList :: ReadS [UpdateResource]
$creadList :: ReadS [UpdateResource]
readsPrec :: Int -> ReadS UpdateResource
$creadsPrec :: Int -> ReadS UpdateResource
Prelude.Read, Int -> UpdateResource -> ShowS
[UpdateResource] -> ShowS
UpdateResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateResource] -> ShowS
$cshowList :: [UpdateResource] -> ShowS
show :: UpdateResource -> String
$cshow :: UpdateResource -> String
showsPrec :: Int -> UpdateResource -> ShowS
$cshowsPrec :: Int -> UpdateResource -> ShowS
Prelude.Show, forall x. Rep UpdateResource x -> UpdateResource
forall x. UpdateResource -> Rep UpdateResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateResource x -> UpdateResource
$cfrom :: forall x. UpdateResource -> Rep UpdateResource x
Prelude.Generic)

-- |
-- Create a value of 'UpdateResource' 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:
--
-- 'bookingOptions', 'updateResource_bookingOptions' - The resource\'s booking options to be updated.
--
-- 'name', 'updateResource_name' - The name of the resource to be updated.
--
-- 'organizationId', 'updateResource_organizationId' - The identifier associated with the organization for which the resource
-- is updated.
--
-- 'resourceId', 'updateResource_resourceId' - The identifier of the resource to be updated.
newUpdateResource ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  UpdateResource
newUpdateResource :: Text -> Text -> UpdateResource
newUpdateResource Text
pOrganizationId_ Text
pResourceId_ =
  UpdateResource'
    { $sel:bookingOptions:UpdateResource' :: Maybe BookingOptions
bookingOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateResource' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationId:UpdateResource' :: Text
organizationId = Text
pOrganizationId_,
      $sel:resourceId:UpdateResource' :: Text
resourceId = Text
pResourceId_
    }

-- | The resource\'s booking options to be updated.
updateResource_bookingOptions :: Lens.Lens' UpdateResource (Prelude.Maybe BookingOptions)
updateResource_bookingOptions :: Lens' UpdateResource (Maybe BookingOptions)
updateResource_bookingOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResource' {Maybe BookingOptions
bookingOptions :: Maybe BookingOptions
$sel:bookingOptions:UpdateResource' :: UpdateResource -> Maybe BookingOptions
bookingOptions} -> Maybe BookingOptions
bookingOptions) (\s :: UpdateResource
s@UpdateResource' {} Maybe BookingOptions
a -> UpdateResource
s {$sel:bookingOptions:UpdateResource' :: Maybe BookingOptions
bookingOptions = Maybe BookingOptions
a} :: UpdateResource)

-- | The name of the resource to be updated.
updateResource_name :: Lens.Lens' UpdateResource (Prelude.Maybe Prelude.Text)
updateResource_name :: Lens' UpdateResource (Maybe Text)
updateResource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResource' {Maybe Text
name :: Maybe Text
$sel:name:UpdateResource' :: UpdateResource -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateResource
s@UpdateResource' {} Maybe Text
a -> UpdateResource
s {$sel:name:UpdateResource' :: Maybe Text
name = Maybe Text
a} :: UpdateResource)

-- | The identifier associated with the organization for which the resource
-- is updated.
updateResource_organizationId :: Lens.Lens' UpdateResource Prelude.Text
updateResource_organizationId :: Lens' UpdateResource Text
updateResource_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResource' {Text
organizationId :: Text
$sel:organizationId:UpdateResource' :: UpdateResource -> Text
organizationId} -> Text
organizationId) (\s :: UpdateResource
s@UpdateResource' {} Text
a -> UpdateResource
s {$sel:organizationId:UpdateResource' :: Text
organizationId = Text
a} :: UpdateResource)

-- | The identifier of the resource to be updated.
updateResource_resourceId :: Lens.Lens' UpdateResource Prelude.Text
updateResource_resourceId :: Lens' UpdateResource Text
updateResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResource' {Text
resourceId :: Text
$sel:resourceId:UpdateResource' :: UpdateResource -> Text
resourceId} -> Text
resourceId) (\s :: UpdateResource
s@UpdateResource' {} Text
a -> UpdateResource
s {$sel:resourceId:UpdateResource' :: Text
resourceId = Text
a} :: UpdateResource)

instance Core.AWSRequest UpdateResource where
  type
    AWSResponse UpdateResource =
      UpdateResourceResponse
  request :: (Service -> Service) -> UpdateResource -> Request UpdateResource
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 UpdateResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateResource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateResourceResponse
UpdateResourceResponse'
            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))
      )

instance Prelude.Hashable UpdateResource where
  hashWithSalt :: Int -> UpdateResource -> Int
hashWithSalt Int
_salt UpdateResource' {Maybe Text
Maybe BookingOptions
Text
resourceId :: Text
organizationId :: Text
name :: Maybe Text
bookingOptions :: Maybe BookingOptions
$sel:resourceId:UpdateResource' :: UpdateResource -> Text
$sel:organizationId:UpdateResource' :: UpdateResource -> Text
$sel:name:UpdateResource' :: UpdateResource -> Maybe Text
$sel:bookingOptions:UpdateResource' :: UpdateResource -> Maybe BookingOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BookingOptions
bookingOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData UpdateResource where
  rnf :: UpdateResource -> ()
rnf UpdateResource' {Maybe Text
Maybe BookingOptions
Text
resourceId :: Text
organizationId :: Text
name :: Maybe Text
bookingOptions :: Maybe BookingOptions
$sel:resourceId:UpdateResource' :: UpdateResource -> Text
$sel:organizationId:UpdateResource' :: UpdateResource -> Text
$sel:name:UpdateResource' :: UpdateResource -> Maybe Text
$sel:bookingOptions:UpdateResource' :: UpdateResource -> Maybe BookingOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BookingOptions
bookingOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

instance Data.ToHeaders UpdateResource where
  toHeaders :: UpdateResource -> 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
"WorkMailService.UpdateResource" ::
                          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 UpdateResource where
  toJSON :: UpdateResource -> Value
toJSON UpdateResource' {Maybe Text
Maybe BookingOptions
Text
resourceId :: Text
organizationId :: Text
name :: Maybe Text
bookingOptions :: Maybe BookingOptions
$sel:resourceId:UpdateResource' :: UpdateResource -> Text
$sel:organizationId:UpdateResource' :: UpdateResource -> Text
$sel:name:UpdateResource' :: UpdateResource -> Maybe Text
$sel:bookingOptions:UpdateResource' :: UpdateResource -> Maybe BookingOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BookingOptions" 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 BookingOptions
bookingOptions,
            (Key
"Name" 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 Text
name,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateResourceResponse' 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', 'updateResourceResponse_httpStatus' - The response's http status code.
newUpdateResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateResourceResponse
newUpdateResourceResponse :: Int -> UpdateResourceResponse
newUpdateResourceResponse Int
pHttpStatus_ =
  UpdateResourceResponse' {$sel:httpStatus:UpdateResourceResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateResourceResponse where
  rnf :: UpdateResourceResponse -> ()
rnf UpdateResourceResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateResourceResponse' :: UpdateResourceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus