{-# 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.WorkSpaces.UpdateWorkspaceImagePermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Shares or unshares an image with one account in the same Amazon Web
-- Services Region by specifying whether that account has permission to
-- copy the image. If the copy image permission is granted, the image is
-- shared with that account. If the copy image permission is revoked, the
-- image is unshared with the account.
--
-- After an image has been shared, the recipient account can copy the image
-- to other Regions as needed.
--
-- In the China (Ningxia) Region, you can copy images only within the same
-- Region.
--
-- In Amazon Web Services GovCloud (US), to copy images to and from other
-- Regions, contact Amazon Web Services Support.
--
-- For more information about sharing images, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/share-custom-image.html Share or Unshare a Custom WorkSpaces Image>.
--
-- -   To delete an image that has been shared, you must unshare the image
--     before you delete it.
--
-- -   Sharing Bring Your Own License (BYOL) images across Amazon Web
--     Services accounts isn\'t supported at this time in Amazon Web
--     Services GovCloud (US). To share BYOL images across accounts in
--     Amazon Web Services GovCloud (US), contact Amazon Web Services
--     Support.
module Amazonka.WorkSpaces.UpdateWorkspaceImagePermission
  ( -- * Creating a Request
    UpdateWorkspaceImagePermission (..),
    newUpdateWorkspaceImagePermission,

    -- * Request Lenses
    updateWorkspaceImagePermission_imageId,
    updateWorkspaceImagePermission_allowCopyImage,
    updateWorkspaceImagePermission_sharedAccountId,

    -- * Destructuring the Response
    UpdateWorkspaceImagePermissionResponse (..),
    newUpdateWorkspaceImagePermissionResponse,

    -- * Response Lenses
    updateWorkspaceImagePermissionResponse_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.WorkSpaces.Types

-- | /See:/ 'newUpdateWorkspaceImagePermission' smart constructor.
data UpdateWorkspaceImagePermission = UpdateWorkspaceImagePermission'
  { -- | The identifier of the image.
    UpdateWorkspaceImagePermission -> Text
imageId :: Prelude.Text,
    -- | The permission to copy the image. This permission can be revoked only
    -- after an image has been shared.
    UpdateWorkspaceImagePermission -> Bool
allowCopyImage :: Prelude.Bool,
    -- | The identifier of the Amazon Web Services account to share or unshare
    -- the image with.
    --
    -- Before sharing the image, confirm that you are sharing to the correct
    -- Amazon Web Services account ID.
    UpdateWorkspaceImagePermission -> Text
sharedAccountId :: Prelude.Text
  }
  deriving (UpdateWorkspaceImagePermission
-> UpdateWorkspaceImagePermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkspaceImagePermission
-> UpdateWorkspaceImagePermission -> Bool
$c/= :: UpdateWorkspaceImagePermission
-> UpdateWorkspaceImagePermission -> Bool
== :: UpdateWorkspaceImagePermission
-> UpdateWorkspaceImagePermission -> Bool
$c== :: UpdateWorkspaceImagePermission
-> UpdateWorkspaceImagePermission -> Bool
Prelude.Eq, ReadPrec [UpdateWorkspaceImagePermission]
ReadPrec UpdateWorkspaceImagePermission
Int -> ReadS UpdateWorkspaceImagePermission
ReadS [UpdateWorkspaceImagePermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkspaceImagePermission]
$creadListPrec :: ReadPrec [UpdateWorkspaceImagePermission]
readPrec :: ReadPrec UpdateWorkspaceImagePermission
$creadPrec :: ReadPrec UpdateWorkspaceImagePermission
readList :: ReadS [UpdateWorkspaceImagePermission]
$creadList :: ReadS [UpdateWorkspaceImagePermission]
readsPrec :: Int -> ReadS UpdateWorkspaceImagePermission
$creadsPrec :: Int -> ReadS UpdateWorkspaceImagePermission
Prelude.Read, Int -> UpdateWorkspaceImagePermission -> ShowS
[UpdateWorkspaceImagePermission] -> ShowS
UpdateWorkspaceImagePermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkspaceImagePermission] -> ShowS
$cshowList :: [UpdateWorkspaceImagePermission] -> ShowS
show :: UpdateWorkspaceImagePermission -> String
$cshow :: UpdateWorkspaceImagePermission -> String
showsPrec :: Int -> UpdateWorkspaceImagePermission -> ShowS
$cshowsPrec :: Int -> UpdateWorkspaceImagePermission -> ShowS
Prelude.Show, forall x.
Rep UpdateWorkspaceImagePermission x
-> UpdateWorkspaceImagePermission
forall x.
UpdateWorkspaceImagePermission
-> Rep UpdateWorkspaceImagePermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateWorkspaceImagePermission x
-> UpdateWorkspaceImagePermission
$cfrom :: forall x.
UpdateWorkspaceImagePermission
-> Rep UpdateWorkspaceImagePermission x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkspaceImagePermission' 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:
--
-- 'imageId', 'updateWorkspaceImagePermission_imageId' - The identifier of the image.
--
-- 'allowCopyImage', 'updateWorkspaceImagePermission_allowCopyImage' - The permission to copy the image. This permission can be revoked only
-- after an image has been shared.
--
-- 'sharedAccountId', 'updateWorkspaceImagePermission_sharedAccountId' - The identifier of the Amazon Web Services account to share or unshare
-- the image with.
--
-- Before sharing the image, confirm that you are sharing to the correct
-- Amazon Web Services account ID.
newUpdateWorkspaceImagePermission ::
  -- | 'imageId'
  Prelude.Text ->
  -- | 'allowCopyImage'
  Prelude.Bool ->
  -- | 'sharedAccountId'
  Prelude.Text ->
  UpdateWorkspaceImagePermission
newUpdateWorkspaceImagePermission :: Text -> Bool -> Text -> UpdateWorkspaceImagePermission
newUpdateWorkspaceImagePermission
  Text
pImageId_
  Bool
pAllowCopyImage_
  Text
pSharedAccountId_ =
    UpdateWorkspaceImagePermission'
      { $sel:imageId:UpdateWorkspaceImagePermission' :: Text
imageId =
          Text
pImageId_,
        $sel:allowCopyImage:UpdateWorkspaceImagePermission' :: Bool
allowCopyImage = Bool
pAllowCopyImage_,
        $sel:sharedAccountId:UpdateWorkspaceImagePermission' :: Text
sharedAccountId = Text
pSharedAccountId_
      }

-- | The identifier of the image.
updateWorkspaceImagePermission_imageId :: Lens.Lens' UpdateWorkspaceImagePermission Prelude.Text
updateWorkspaceImagePermission_imageId :: Lens' UpdateWorkspaceImagePermission Text
updateWorkspaceImagePermission_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceImagePermission' {Text
imageId :: Text
$sel:imageId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
imageId} -> Text
imageId) (\s :: UpdateWorkspaceImagePermission
s@UpdateWorkspaceImagePermission' {} Text
a -> UpdateWorkspaceImagePermission
s {$sel:imageId:UpdateWorkspaceImagePermission' :: Text
imageId = Text
a} :: UpdateWorkspaceImagePermission)

-- | The permission to copy the image. This permission can be revoked only
-- after an image has been shared.
updateWorkspaceImagePermission_allowCopyImage :: Lens.Lens' UpdateWorkspaceImagePermission Prelude.Bool
updateWorkspaceImagePermission_allowCopyImage :: Lens' UpdateWorkspaceImagePermission Bool
updateWorkspaceImagePermission_allowCopyImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceImagePermission' {Bool
allowCopyImage :: Bool
$sel:allowCopyImage:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Bool
allowCopyImage} -> Bool
allowCopyImage) (\s :: UpdateWorkspaceImagePermission
s@UpdateWorkspaceImagePermission' {} Bool
a -> UpdateWorkspaceImagePermission
s {$sel:allowCopyImage:UpdateWorkspaceImagePermission' :: Bool
allowCopyImage = Bool
a} :: UpdateWorkspaceImagePermission)

-- | The identifier of the Amazon Web Services account to share or unshare
-- the image with.
--
-- Before sharing the image, confirm that you are sharing to the correct
-- Amazon Web Services account ID.
updateWorkspaceImagePermission_sharedAccountId :: Lens.Lens' UpdateWorkspaceImagePermission Prelude.Text
updateWorkspaceImagePermission_sharedAccountId :: Lens' UpdateWorkspaceImagePermission Text
updateWorkspaceImagePermission_sharedAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceImagePermission' {Text
sharedAccountId :: Text
$sel:sharedAccountId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
sharedAccountId} -> Text
sharedAccountId) (\s :: UpdateWorkspaceImagePermission
s@UpdateWorkspaceImagePermission' {} Text
a -> UpdateWorkspaceImagePermission
s {$sel:sharedAccountId:UpdateWorkspaceImagePermission' :: Text
sharedAccountId = Text
a} :: UpdateWorkspaceImagePermission)

instance
  Core.AWSRequest
    UpdateWorkspaceImagePermission
  where
  type
    AWSResponse UpdateWorkspaceImagePermission =
      UpdateWorkspaceImagePermissionResponse
  request :: (Service -> Service)
-> UpdateWorkspaceImagePermission
-> Request UpdateWorkspaceImagePermission
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 UpdateWorkspaceImagePermission
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateWorkspaceImagePermission)))
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 -> UpdateWorkspaceImagePermissionResponse
UpdateWorkspaceImagePermissionResponse'
            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
    UpdateWorkspaceImagePermission
  where
  hashWithSalt :: Int -> UpdateWorkspaceImagePermission -> Int
hashWithSalt
    Int
_salt
    UpdateWorkspaceImagePermission' {Bool
Text
sharedAccountId :: Text
allowCopyImage :: Bool
imageId :: Text
$sel:sharedAccountId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
$sel:allowCopyImage:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Bool
$sel:imageId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
allowCopyImage
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sharedAccountId

instance
  Prelude.NFData
    UpdateWorkspaceImagePermission
  where
  rnf :: UpdateWorkspaceImagePermission -> ()
rnf UpdateWorkspaceImagePermission' {Bool
Text
sharedAccountId :: Text
allowCopyImage :: Bool
imageId :: Text
$sel:sharedAccountId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
$sel:allowCopyImage:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Bool
$sel:imageId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
allowCopyImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sharedAccountId

instance
  Data.ToHeaders
    UpdateWorkspaceImagePermission
  where
  toHeaders :: UpdateWorkspaceImagePermission -> 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
"WorkspacesService.UpdateWorkspaceImagePermission" ::
                          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 UpdateWorkspaceImagePermission where
  toJSON :: UpdateWorkspaceImagePermission -> Value
toJSON UpdateWorkspaceImagePermission' {Bool
Text
sharedAccountId :: Text
allowCopyImage :: Bool
imageId :: Text
$sel:sharedAccountId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
$sel:allowCopyImage:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Bool
$sel:imageId:UpdateWorkspaceImagePermission' :: UpdateWorkspaceImagePermission -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ImageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
imageId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AllowCopyImage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
allowCopyImage),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SharedAccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sharedAccountId)
          ]
      )

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

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

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

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

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

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