{-# 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.Nimble.GetStudioMember
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get a user\'s membership in a studio.
module Amazonka.Nimble.GetStudioMember
  ( -- * Creating a Request
    GetStudioMember (..),
    newGetStudioMember,

    -- * Request Lenses
    getStudioMember_principalId,
    getStudioMember_studioId,

    -- * Destructuring the Response
    GetStudioMemberResponse (..),
    newGetStudioMemberResponse,

    -- * Response Lenses
    getStudioMemberResponse_member,
    getStudioMemberResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Nimble.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetStudioMember' smart constructor.
data GetStudioMember = GetStudioMember'
  { -- | The principal ID. This currently supports a IAM Identity Center UserId.
    GetStudioMember -> Text
principalId :: Prelude.Text,
    -- | The studio ID.
    GetStudioMember -> Text
studioId :: Prelude.Text
  }
  deriving (GetStudioMember -> GetStudioMember -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStudioMember -> GetStudioMember -> Bool
$c/= :: GetStudioMember -> GetStudioMember -> Bool
== :: GetStudioMember -> GetStudioMember -> Bool
$c== :: GetStudioMember -> GetStudioMember -> Bool
Prelude.Eq, ReadPrec [GetStudioMember]
ReadPrec GetStudioMember
Int -> ReadS GetStudioMember
ReadS [GetStudioMember]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStudioMember]
$creadListPrec :: ReadPrec [GetStudioMember]
readPrec :: ReadPrec GetStudioMember
$creadPrec :: ReadPrec GetStudioMember
readList :: ReadS [GetStudioMember]
$creadList :: ReadS [GetStudioMember]
readsPrec :: Int -> ReadS GetStudioMember
$creadsPrec :: Int -> ReadS GetStudioMember
Prelude.Read, Int -> GetStudioMember -> ShowS
[GetStudioMember] -> ShowS
GetStudioMember -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStudioMember] -> ShowS
$cshowList :: [GetStudioMember] -> ShowS
show :: GetStudioMember -> String
$cshow :: GetStudioMember -> String
showsPrec :: Int -> GetStudioMember -> ShowS
$cshowsPrec :: Int -> GetStudioMember -> ShowS
Prelude.Show, forall x. Rep GetStudioMember x -> GetStudioMember
forall x. GetStudioMember -> Rep GetStudioMember x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStudioMember x -> GetStudioMember
$cfrom :: forall x. GetStudioMember -> Rep GetStudioMember x
Prelude.Generic)

-- |
-- Create a value of 'GetStudioMember' 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:
--
-- 'principalId', 'getStudioMember_principalId' - The principal ID. This currently supports a IAM Identity Center UserId.
--
-- 'studioId', 'getStudioMember_studioId' - The studio ID.
newGetStudioMember ::
  -- | 'principalId'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  GetStudioMember
newGetStudioMember :: Text -> Text -> GetStudioMember
newGetStudioMember Text
pPrincipalId_ Text
pStudioId_ =
  GetStudioMember'
    { $sel:principalId:GetStudioMember' :: Text
principalId = Text
pPrincipalId_,
      $sel:studioId:GetStudioMember' :: Text
studioId = Text
pStudioId_
    }

-- | The principal ID. This currently supports a IAM Identity Center UserId.
getStudioMember_principalId :: Lens.Lens' GetStudioMember Prelude.Text
getStudioMember_principalId :: Lens' GetStudioMember Text
getStudioMember_principalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioMember' {Text
principalId :: Text
$sel:principalId:GetStudioMember' :: GetStudioMember -> Text
principalId} -> Text
principalId) (\s :: GetStudioMember
s@GetStudioMember' {} Text
a -> GetStudioMember
s {$sel:principalId:GetStudioMember' :: Text
principalId = Text
a} :: GetStudioMember)

-- | The studio ID.
getStudioMember_studioId :: Lens.Lens' GetStudioMember Prelude.Text
getStudioMember_studioId :: Lens' GetStudioMember Text
getStudioMember_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioMember' {Text
studioId :: Text
$sel:studioId:GetStudioMember' :: GetStudioMember -> Text
studioId} -> Text
studioId) (\s :: GetStudioMember
s@GetStudioMember' {} Text
a -> GetStudioMember
s {$sel:studioId:GetStudioMember' :: Text
studioId = Text
a} :: GetStudioMember)

instance Core.AWSRequest GetStudioMember where
  type
    AWSResponse GetStudioMember =
      GetStudioMemberResponse
  request :: (Service -> Service) -> GetStudioMember -> Request GetStudioMember
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetStudioMember
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetStudioMember)))
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 StudioMembership -> Int -> GetStudioMemberResponse
GetStudioMemberResponse'
            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
"member")
            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 GetStudioMember where
  hashWithSalt :: Int -> GetStudioMember -> Int
hashWithSalt Int
_salt GetStudioMember' {Text
studioId :: Text
principalId :: Text
$sel:studioId:GetStudioMember' :: GetStudioMember -> Text
$sel:principalId:GetStudioMember' :: GetStudioMember -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principalId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData GetStudioMember where
  rnf :: GetStudioMember -> ()
rnf GetStudioMember' {Text
studioId :: Text
principalId :: Text
$sel:studioId:GetStudioMember' :: GetStudioMember -> Text
$sel:principalId:GetStudioMember' :: GetStudioMember -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
principalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders GetStudioMember where
  toHeaders :: GetStudioMember -> 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.ToPath GetStudioMember where
  toPath :: GetStudioMember -> ByteString
toPath GetStudioMember' {Text
studioId :: Text
principalId :: Text
$sel:studioId:GetStudioMember' :: GetStudioMember -> Text
$sel:principalId:GetStudioMember' :: GetStudioMember -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-08-01/studios/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
studioId,
        ByteString
"/membership/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
principalId
      ]

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

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

-- |
-- Create a value of 'GetStudioMemberResponse' 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:
--
-- 'member', 'getStudioMemberResponse_member' - The member.
--
-- 'httpStatus', 'getStudioMemberResponse_httpStatus' - The response's http status code.
newGetStudioMemberResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStudioMemberResponse
newGetStudioMemberResponse :: Int -> GetStudioMemberResponse
newGetStudioMemberResponse Int
pHttpStatus_ =
  GetStudioMemberResponse'
    { $sel:member:GetStudioMemberResponse' :: Maybe StudioMembership
member = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStudioMemberResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The member.
getStudioMemberResponse_member :: Lens.Lens' GetStudioMemberResponse (Prelude.Maybe StudioMembership)
getStudioMemberResponse_member :: Lens' GetStudioMemberResponse (Maybe StudioMembership)
getStudioMemberResponse_member = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioMemberResponse' {Maybe StudioMembership
member :: Maybe StudioMembership
$sel:member:GetStudioMemberResponse' :: GetStudioMemberResponse -> Maybe StudioMembership
member} -> Maybe StudioMembership
member) (\s :: GetStudioMemberResponse
s@GetStudioMemberResponse' {} Maybe StudioMembership
a -> GetStudioMemberResponse
s {$sel:member:GetStudioMemberResponse' :: Maybe StudioMembership
member = Maybe StudioMembership
a} :: GetStudioMemberResponse)

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

instance Prelude.NFData GetStudioMemberResponse where
  rnf :: GetStudioMemberResponse -> ()
rnf GetStudioMemberResponse' {Int
Maybe StudioMembership
httpStatus :: Int
member :: Maybe StudioMembership
$sel:httpStatus:GetStudioMemberResponse' :: GetStudioMemberResponse -> Int
$sel:member:GetStudioMemberResponse' :: GetStudioMemberResponse -> Maybe StudioMembership
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StudioMembership
member
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus