{-# 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.GetStudio
-- 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 studio resource.
module Amazonka.Nimble.GetStudio
  ( -- * Creating a Request
    GetStudio (..),
    newGetStudio,

    -- * Request Lenses
    getStudio_studioId,

    -- * Destructuring the Response
    GetStudioResponse (..),
    newGetStudioResponse,

    -- * Response Lenses
    getStudioResponse_httpStatus,
    getStudioResponse_studio,
  )
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:/ 'newGetStudio' smart constructor.
data GetStudio = GetStudio'
  { -- | The studio ID.
    GetStudio -> Text
studioId :: Prelude.Text
  }
  deriving (GetStudio -> GetStudio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStudio -> GetStudio -> Bool
$c/= :: GetStudio -> GetStudio -> Bool
== :: GetStudio -> GetStudio -> Bool
$c== :: GetStudio -> GetStudio -> Bool
Prelude.Eq, ReadPrec [GetStudio]
ReadPrec GetStudio
Int -> ReadS GetStudio
ReadS [GetStudio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStudio]
$creadListPrec :: ReadPrec [GetStudio]
readPrec :: ReadPrec GetStudio
$creadPrec :: ReadPrec GetStudio
readList :: ReadS [GetStudio]
$creadList :: ReadS [GetStudio]
readsPrec :: Int -> ReadS GetStudio
$creadsPrec :: Int -> ReadS GetStudio
Prelude.Read, Int -> GetStudio -> ShowS
[GetStudio] -> ShowS
GetStudio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStudio] -> ShowS
$cshowList :: [GetStudio] -> ShowS
show :: GetStudio -> String
$cshow :: GetStudio -> String
showsPrec :: Int -> GetStudio -> ShowS
$cshowsPrec :: Int -> GetStudio -> ShowS
Prelude.Show, forall x. Rep GetStudio x -> GetStudio
forall x. GetStudio -> Rep GetStudio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStudio x -> GetStudio
$cfrom :: forall x. GetStudio -> Rep GetStudio x
Prelude.Generic)

-- |
-- Create a value of 'GetStudio' 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:
--
-- 'studioId', 'getStudio_studioId' - The studio ID.
newGetStudio ::
  -- | 'studioId'
  Prelude.Text ->
  GetStudio
newGetStudio :: Text -> GetStudio
newGetStudio Text
pStudioId_ =
  GetStudio' {$sel:studioId:GetStudio' :: Text
studioId = Text
pStudioId_}

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

instance Core.AWSRequest GetStudio where
  type AWSResponse GetStudio = GetStudioResponse
  request :: (Service -> Service) -> GetStudio -> Request GetStudio
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 GetStudio
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetStudio)))
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 ->
          Int -> Studio -> GetStudioResponse
GetStudioResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"studio")
      )

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

instance Prelude.NFData GetStudio where
  rnf :: GetStudio -> ()
rnf GetStudio' {Text
studioId :: Text
$sel:studioId:GetStudio' :: GetStudio -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

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

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

-- | /See:/ 'newGetStudioResponse' smart constructor.
data GetStudioResponse = GetStudioResponse'
  { -- | The response's http status code.
    GetStudioResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about a studio.
    GetStudioResponse -> Studio
studio :: Studio
  }
  deriving (GetStudioResponse -> GetStudioResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStudioResponse -> GetStudioResponse -> Bool
$c/= :: GetStudioResponse -> GetStudioResponse -> Bool
== :: GetStudioResponse -> GetStudioResponse -> Bool
$c== :: GetStudioResponse -> GetStudioResponse -> Bool
Prelude.Eq, Int -> GetStudioResponse -> ShowS
[GetStudioResponse] -> ShowS
GetStudioResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStudioResponse] -> ShowS
$cshowList :: [GetStudioResponse] -> ShowS
show :: GetStudioResponse -> String
$cshow :: GetStudioResponse -> String
showsPrec :: Int -> GetStudioResponse -> ShowS
$cshowsPrec :: Int -> GetStudioResponse -> ShowS
Prelude.Show, forall x. Rep GetStudioResponse x -> GetStudioResponse
forall x. GetStudioResponse -> Rep GetStudioResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStudioResponse x -> GetStudioResponse
$cfrom :: forall x. GetStudioResponse -> Rep GetStudioResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStudioResponse' 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', 'getStudioResponse_httpStatus' - The response's http status code.
--
-- 'studio', 'getStudioResponse_studio' - Information about a studio.
newGetStudioResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'studio'
  Studio ->
  GetStudioResponse
newGetStudioResponse :: Int -> Studio -> GetStudioResponse
newGetStudioResponse Int
pHttpStatus_ Studio
pStudio_ =
  GetStudioResponse'
    { $sel:httpStatus:GetStudioResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:studio:GetStudioResponse' :: Studio
studio = Studio
pStudio_
    }

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

-- | Information about a studio.
getStudioResponse_studio :: Lens.Lens' GetStudioResponse Studio
getStudioResponse_studio :: Lens' GetStudioResponse Studio
getStudioResponse_studio = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioResponse' {Studio
studio :: Studio
$sel:studio:GetStudioResponse' :: GetStudioResponse -> Studio
studio} -> Studio
studio) (\s :: GetStudioResponse
s@GetStudioResponse' {} Studio
a -> GetStudioResponse
s {$sel:studio:GetStudioResponse' :: Studio
studio = Studio
a} :: GetStudioResponse)

instance Prelude.NFData GetStudioResponse where
  rnf :: GetStudioResponse -> ()
rnf GetStudioResponse' {Int
Studio
studio :: Studio
httpStatus :: Int
$sel:studio:GetStudioResponse' :: GetStudioResponse -> Studio
$sel:httpStatus:GetStudioResponse' :: GetStudioResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Studio
studio