{-# 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.ServerlessApplicationRepository.UnshareApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Unshares an application from an AWS Organization.
--
-- This operation can be called only from the organization\'s master
-- account.
module Amazonka.ServerlessApplicationRepository.UnshareApplication
  ( -- * Creating a Request
    UnshareApplication (..),
    newUnshareApplication,

    -- * Request Lenses
    unshareApplication_applicationId,
    unshareApplication_organizationId,

    -- * Destructuring the Response
    UnshareApplicationResponse (..),
    newUnshareApplicationResponse,
  )
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.ServerlessApplicationRepository.Types

-- | /See:/ 'newUnshareApplication' smart constructor.
data UnshareApplication = UnshareApplication'
  { -- | The Amazon Resource Name (ARN) of the application.
    UnshareApplication -> Text
applicationId :: Prelude.Text,
    -- | The AWS Organization ID to unshare the application from.
    UnshareApplication -> Text
organizationId :: Prelude.Text
  }
  deriving (UnshareApplication -> UnshareApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnshareApplication -> UnshareApplication -> Bool
$c/= :: UnshareApplication -> UnshareApplication -> Bool
== :: UnshareApplication -> UnshareApplication -> Bool
$c== :: UnshareApplication -> UnshareApplication -> Bool
Prelude.Eq, ReadPrec [UnshareApplication]
ReadPrec UnshareApplication
Int -> ReadS UnshareApplication
ReadS [UnshareApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnshareApplication]
$creadListPrec :: ReadPrec [UnshareApplication]
readPrec :: ReadPrec UnshareApplication
$creadPrec :: ReadPrec UnshareApplication
readList :: ReadS [UnshareApplication]
$creadList :: ReadS [UnshareApplication]
readsPrec :: Int -> ReadS UnshareApplication
$creadsPrec :: Int -> ReadS UnshareApplication
Prelude.Read, Int -> UnshareApplication -> ShowS
[UnshareApplication] -> ShowS
UnshareApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnshareApplication] -> ShowS
$cshowList :: [UnshareApplication] -> ShowS
show :: UnshareApplication -> String
$cshow :: UnshareApplication -> String
showsPrec :: Int -> UnshareApplication -> ShowS
$cshowsPrec :: Int -> UnshareApplication -> ShowS
Prelude.Show, forall x. Rep UnshareApplication x -> UnshareApplication
forall x. UnshareApplication -> Rep UnshareApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnshareApplication x -> UnshareApplication
$cfrom :: forall x. UnshareApplication -> Rep UnshareApplication x
Prelude.Generic)

-- |
-- Create a value of 'UnshareApplication' 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:
--
-- 'applicationId', 'unshareApplication_applicationId' - The Amazon Resource Name (ARN) of the application.
--
-- 'organizationId', 'unshareApplication_organizationId' - The AWS Organization ID to unshare the application from.
newUnshareApplication ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'organizationId'
  Prelude.Text ->
  UnshareApplication
newUnshareApplication :: Text -> Text -> UnshareApplication
newUnshareApplication
  Text
pApplicationId_
  Text
pOrganizationId_ =
    UnshareApplication'
      { $sel:applicationId:UnshareApplication' :: Text
applicationId =
          Text
pApplicationId_,
        $sel:organizationId:UnshareApplication' :: Text
organizationId = Text
pOrganizationId_
      }

-- | The Amazon Resource Name (ARN) of the application.
unshareApplication_applicationId :: Lens.Lens' UnshareApplication Prelude.Text
unshareApplication_applicationId :: Lens' UnshareApplication Text
unshareApplication_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnshareApplication' {Text
applicationId :: Text
$sel:applicationId:UnshareApplication' :: UnshareApplication -> Text
applicationId} -> Text
applicationId) (\s :: UnshareApplication
s@UnshareApplication' {} Text
a -> UnshareApplication
s {$sel:applicationId:UnshareApplication' :: Text
applicationId = Text
a} :: UnshareApplication)

-- | The AWS Organization ID to unshare the application from.
unshareApplication_organizationId :: Lens.Lens' UnshareApplication Prelude.Text
unshareApplication_organizationId :: Lens' UnshareApplication Text
unshareApplication_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnshareApplication' {Text
organizationId :: Text
$sel:organizationId:UnshareApplication' :: UnshareApplication -> Text
organizationId} -> Text
organizationId) (\s :: UnshareApplication
s@UnshareApplication' {} Text
a -> UnshareApplication
s {$sel:organizationId:UnshareApplication' :: Text
organizationId = Text
a} :: UnshareApplication)

instance Core.AWSRequest UnshareApplication where
  type
    AWSResponse UnshareApplication =
      UnshareApplicationResponse
  request :: (Service -> Service)
-> UnshareApplication -> Request UnshareApplication
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 UnshareApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UnshareApplication)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UnshareApplicationResponse
UnshareApplicationResponse'

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

instance Prelude.NFData UnshareApplication where
  rnf :: UnshareApplication -> ()
rnf UnshareApplication' {Text
organizationId :: Text
applicationId :: Text
$sel:organizationId:UnshareApplication' :: UnshareApplication -> Text
$sel:applicationId:UnshareApplication' :: UnshareApplication -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId

instance Data.ToHeaders UnshareApplication where
  toHeaders :: UnshareApplication -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance Data.ToPath UnshareApplication where
  toPath :: UnshareApplication -> ByteString
toPath UnshareApplication' {Text
organizationId :: Text
applicationId :: Text
$sel:organizationId:UnshareApplication' :: UnshareApplication -> Text
$sel:applicationId:UnshareApplication' :: UnshareApplication -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/unshare"
      ]

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

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

-- |
-- Create a value of 'UnshareApplicationResponse' 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.
newUnshareApplicationResponse ::
  UnshareApplicationResponse
newUnshareApplicationResponse :: UnshareApplicationResponse
newUnshareApplicationResponse =
  UnshareApplicationResponse
UnshareApplicationResponse'

instance Prelude.NFData UnshareApplicationResponse where
  rnf :: UnshareApplicationResponse -> ()
rnf UnshareApplicationResponse
_ = ()